####################################################################
#
# pbemtools.pl: Common functions we include everywhere
#
# # Copyright 1998 Alan Schwartz
# # 
# # This file is part of pbemtools.
# # 
# # pbemtools is free software; you can redistribute it and/or modify
# # it under the terms of the GNU General Public License as published by
# # the Free Software Foundation; either version 2, or (at your option)
# # any later version.
# # 
# # pbemtools is distributed in the hope that it will be useful,
# # but WITHOUT ANY WARRANTY; without even the implied warranty of
# # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# # GNU General Public License for more details.
# # 
# # You should have received a copy of the GNU General Public License
# # along with pbemtools; see the file COPYING.
# # If not, write to the Free Software Foundation,
# # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# # 
# # Report problems and direct all questions to:
# # 
# #     alansz@pennmush.org
# # 

my $Version = "pbemtools 1.5 (11/09/01)";

# Can $who understand writing for/in $what?
sub speaks {
  my($who,$what,$speaker) = @_;
  my(@testlangs,$tlang);
  # Speaker always hears themself
  return 1 if ($speaker && $speaker =~ /$who/i);
  # Downcase things.
  $who =~ tr/A-Z/a-z/;
  $what =~ tr/A-Z/a-z/;
  $what = &expandlang($what);
  # Handle messages to a specific player
  if ($what =~ /$who(,|\>|$)/i) {
    return ($what =~ /!/) ? 0 : 1;
  }
  # Handle languages
  return 1 if ($Languages{$who} eq "all");
  return 1 if ($what =~ /\ball\b/i);
  @testlangs = split(/\s+/,$Languages{$who}); 
  if ($what =~ /!/) {
   # Return 1 if player can't speak that language
   foreach $tlang (@testlangs) {
     return 0 if ($what =~ /$tlang/i);
   }
   return 1;
  } else {
   foreach $tlang (@testlangs) {
     return 1 if ($what =~ /$tlang/i);
   }
   return 0;
  }
} 

sub expandlang {
  my $what = shift;
  # $what might be an alias for a group, in which case it's surrounded
  # by <>'s, like <ashore>. Expand alias here.
  $what =~ tr/A-Z/a-z/;
  1 while $what =~ s/\<(.*?)\>/$Groups{$1}/;
  return $what;
}

sub getlang {
# Return the primary language for a speaker
  my $langs = $Languages{$_[0]};
  my @langs = split(/\s+/,$lang);
  return $lang[0];
}

sub reallang {
# Return 1 if this is a single language, 0 if it's something else
  my $l = shift;
  return 0 if $l =~ /[,!<]/;
  return 0 if $l =~ /all/i;
  $l =~ tr/A-Z/a-z/;
  $l =~ s#[/ ]##g;
  return 0 if $Languages{$l};
  return 1;
}


#
# turnify: Given a player name, whether or not we're producing html,
#          and Turn source (in an array),
#          return (in an array) the customized Turn for that player
#
sub turnify {
    my $player = shift;
    my $html = shift;
    my @turn = @_;
    my $lang = 'all';
    my @out = ();
    my $inbracket;
  INPUTLINE:
    for (@turn) {
	s#\*(\w+)\*#<B>$1</B>#g if $html;
	s#/(\w+)/#<I>$1</I>#g if $html;
	if (/^\<(.*)\>/) {
	    $lang = $1;
	    next INPUTLINE;
	}
	$inbracket = 1 if (/^\[/);
	if ($inbracket) {
	    $inbracket = 0 if (/\]$/);
	    next INPUTLINE if $html;
	    push(@out,$_);
	} else {
	    push(@out,$_) if (&speaks($player,$lang,$speaker));
	}
    }
  return @out;
}

#################################################################
# Parse the .config file.
#

sub parseconfig {
  my $file = shift;
  my $dir = "$ENV{'HOME'}/.pbemtools";
  my($name,$data);
  open(CONFIG,"$dir/$file") or die "Unable to open $dir/$file\n";
  while (<CONFIG>) {
    next if /^#/;
    next if /^\s+$/;
    chop;
    SWITCH: {
      $Turndir = $1, last SWITCH if /^turndir\s+(\S+)/i;
      $Smtp = $1, last SWITCH if /^smtp\s+(\S+)/i;
      $Webdir = $1, last SWITCH if /^webdir\s+(\S+)/i;
      $Weburl = $1, last SWITCH if /^weburl\s+(\S+)/i;
      $Movedir = $1, last SWITCH if /^movedir\s+(\S+)/i;
      $Moveurl = $1, last SWITCH if /^moveurl\s+(\S+)/i;
      $Mailinglist = $1, last SWITCH if /^mailinglist\s+(\S+)/i;
      $Fullname = $1, last SWITCH if /^fullname\s+(.*?)\s*$/i;
      $Subjecttag = $1, last SWITCH if /^subjecttag\s+(.*?)\s*$/i;
      $Cgiurl = $1, last SWITCH if /^cgiurl\s+(\S+)/i;
      $Cgipath = $1, last SWITCH if /^cgipath\s+(\S+)/i;
      $Chapter = $1, last SWITCH if /^chapter\s+(\S+)/i;
      $Email{"gm"} = $1, last SWITCH if /^gm\s+(\S+)/i;
      if (/^email\s+([^=]+)=\s*(\S+)/i) {
	($name,$data) = ($1,$2);
	$name =~ tr/A-Z/a-z/;
	$name =~ s/\s+$//;
	$name =~ s/^\s+//;
	$Email{$name} = $data;
	last SWITCH;
      }
      if (/^language\s+([^=]+)=\s*(\S+)/i) {
	($name,$data) = ($1,$2);
	$name =~ tr/A-Z/a-z/;
	$name =~ s/\s+$//;
	$name =~ s/^\s+//;
        $data =~ s/ /_/g;
	$Languages{$name} .= " " if $Languages{$name};
	$Languages{$name} .= $data;
	last SWITCH;
      }
      if (/^aliases\s+([^=]+)=\s*(\S+)/i) {
	($name,$data) = ($1,$2);
	$name =~ tr/A-Z/a-z/;
	$name =~ s/\s+$//;
	$name =~ s/^\s+//;
        $data =~ s/ /_/g;
	$Aliases{$name} .= " " if $Aliases{$name};
	$Aliases{$name} .= $data;
	last SWITCH;
      }
      if (/^group\s+([^=]+)=\s*(\S+)/i) {
	($name,$data) = ($1,$2);
	$name =~ tr/A-Z/a-z/;
	$name =~ s/\s+$//;
	$name =~ s/^\s+//;
        $data =~ tr/A-Z/a-z/;
        $data =~ s/\s+,/,/g;
        $data =~ s/,\s+/,/g;
	$Groups{$name} = "gm,$data";
	last SWITCH;
      }
      warn "Unrecognized config line: $_\n";
   } # End of SWITCH
 } # End of while
 close CONFIG;
 # Special case for gm.
 $Languages{"gm"} = "all";
 @Players = keys %Email;
 $Groups{"all"} = join(",",@Players);
}

sub gethomedir {
 my $user = shift;
 my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) =
	 getpwnam($user);
 return $dir;
} 

# Write out a new chapter index file
sub writemaster {
  my $file = shift;
  my $chapter_name = shift;
  my $pbem = shift;
  my $turn = shift;
  my $user = $ENV{'LOGNAME'};
  open(MASTER,">$file") or die "Unable to write $file\n";
print MASTER <<EOF;
<html>
<head>
<title>$Fullname: Chapter $Chapter</title>
</head>
<body>
<h1>$Fullname: Chapter $Chapter: $chapter_name</h1>

<h2><a name="turns">Game Turns</a></h2>
This presentation of the story includes all the details that
any character perceives, including thoughts, dreams, languages, etc.
If you'd like to follow the story from the vantage point of a 
particular character, rather than from an omniscient vantage
point, skip on to <a href="#story-player">The Story (Player Views)</a>.<p>

Here is a 
<a href="$Cgiurl/allturns.cgi?$user+$pbem+$Chapter+gm">concatenation of all the
Turns</a> for convenient printing.<p>
<ul>
<!-- GM -->
</ul>

<h2><a name="story-player">The Story (Player Views)</a></h2>
You can read the story from the viewpoint of:<p>
<ul>
EOF
  foreach (@Players) {
    next if /^gm$/i;
    my $proper = "\u$_";
    my $cap = "\U$_";
    print MASTER <<EOF;
<li><a name="$_" href="$Cgiurl/expand.cgi?$user+$pbem+$Chapter+$_#$_">$proper</a>
 <ul>
 <li><a href="$Cgiurl/allturns.cgi?$user+$pbem+$Chapter+$_">All Turns to date</a>
<!-- $cap -->
 </ul>
EOF
   }
 print MASTER <<EOF;
</ul>

<h2><a name="player-moves">Player Moves</a></h2>
Player moves are archived here in their "omnilingual" form - that is,
as if the reader understands all languages. If you're a player and
don't want to read things your character wouldn't know, skip the
moves and read only Turn postings.
<ul>
<li><a name="move$turn" href="$Cgiurl/expand.cgi?$user+$pbem+$Chapter+move$turn#move$turn">For Turn $turn</a>
  <ul>
<!-- INSERT HERE -->
  </ul>
</ul>
</body>
</html>
EOF
  close(MASTER);
}



1;

