#!/usr/bin/perl -w
# public domain

#use strict;

my $VERSION = 'v3';
my $PREFIX = '/usr/local';
my $CONFDIR = $PREFIX.'/etc/gnarr';

my $single_pass = 1; 

my %subrefs = ( '-h' => [\&help, 'print this help text'],
		'-v' => [\&ver, 'print version information'],
		'-1' => [\&one, 'print one cry and exit (default)'],
		'-m' => [\&mult, 'print multiple cries'],
		'-l' => [\&list, 'list substitutions (long)'] );
open ( CATS, $CONFDIR.'/categories' ) or die 'Cannot open categories config file';

while ( my $cat = <CATS> ) {
  chomp( $cat );
  push( @cats, $cat );
  open( TEMP, $CONFDIR.'/'.$cat ) or die "Cannot open category \'$cat\'";
  while( my $item = <TEMP> ) {
    chomp( $item );
    push( @$cat, $item );
  }
}
  
my $param;
foreach $param (@ARGV) {
 if ($subrefs{$param}) {
  &{${$subrefs{$param}}[0]}();
 }
}

my @base = ();

if (open( BASE, "$CONFDIR/templates" )) {
  push @base, (<BASE>);
  close BASE;
}
if (open( USER, "$ENV{HOME}/.gnarrrc" )) {
  push @base, (<USER>);
  close USER;
}

chomp @base;

die("No data read from template files!\n") if ($#base == -1);

do {

 my $phrase = $base[int rand @base];

 foreach $cat ( @cats ) {
   $ucat = uc( $cat );
   $phrase =~ s/$ucat/@$cat[int rand @$cat]/g;
 }  

 $phrase = ucfirst($phrase);

 print "$phrase\n";
 if ($single_pass) { exit(); }
 print "Another? [Y/n] ";
 
} while ((my $y = <STDIN>) !~ /n/i);

exit();

sub help {
 print "Gnarr $VERSION. Usage:\n";
 my $key;
 foreach $key (keys %subrefs) {
  my $help = ${$subrefs{$key}}[1];
  print "  $key\t\t$help\n";
 }
 print "\n";
 exit();
}

sub ver {
 print "Gnarr $VERSION by Daniel Ryslink <kamamura\@yahoo.com>\n"; 
 print "Based on v2 by Joe Wreschnig <piman\@sacredchao.net>\n";
 print "Based on the Dwarven Battle Cry generator in Dragon Magazine.\n\n";
 print "This program is in the public domain; feel free to modify and redistribute.\n";
 print "Please send any enhancements to piman\@sacredchao.net.\n\n";
 exit();
}

sub one  { $single_pass = 1; }

sub mult { $single_pass = 0; }

sub list {
  foreach $cat ( @cats ) {
    print uc($cat).":\n";
    foreach $item ( @$cat ) {
      print " $item";
    }
    print "\n";
  }    
  exit();
}
