case $CONFIG in
'')
	if test -f config.sh; then TOP=.;
	elif test -f ../config.sh; then TOP=..;
	elif test -f ../../config.sh; then TOP=../..;
	elif test -f ../../../config.sh; then TOP=../../..;
	elif test -f ../../../../config.sh; then TOP=../../../..;
	else
		echo "Can't find config.sh."; exit 1
	fi
	. $TOP/config.sh
	;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting catmoves (with variable substitutions)"
: This section of the file will have variable substitutions done on it.
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front.  You may delete these comments.
$spitshell >catmoves <<!GROK!THIS!
#!$perlpath
#
# catmoves: Put together all of the moves for a given Turn, and try
# to get them in the right order, to make writing the turn easier.
# Usage: catmoves <pbem-shortname> <turn#>
# Example: catmoves mage 3
# The output will be placed in the file "mage-3.src" in your turn directory.
#
# # 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
# # 
#
use lib qw($installperllib .);
use Graph::Edge;
use Graph::Node;
require 'pbemtools.pl';

my \$ls = '$ls';
!GROK!THIS!

: In the following dollars and backticks do not need the extra backslash.
$spitshell >>catmoves <<'!NO!SUBS!'

sub mark;
sub unmark;
sub real_mark;


my $mark = 0;
my @files;
die "Usage: catmoves <pbem-shortname> <turn#>\n" unless $#ARGV == 1;
my $pbem = shift(@ARGV);
my $move = shift(@ARGV);
parseconfig("$pbem.config") or die "Unable to find $pbem.config\n";
chdir("$Movedir/$move") or die "Unable to find $Movedir/$move\n";
chop(@files = `$ls -tr1 *.html`);
open(OUT,">$Turndir/$pbem-$move.src") 
  or die "Unable to create $Turndir/$pbem-$move.src\n";
my @all = ();
# If we have any groups besides "all", we delete "all"
delete $Groups{"all"} if (scalar(keys %Groups) > 1);
my ($grp,@grp,$name,$gm);

# Here's the object of the game:
# For each group, for each file by someone in the group,
# (1) Preprocess the file by reading it in, detagging it,
#     and throwing out quoted paragraphs
#     if they're followed by other quoted paragraphs.
# (2) Go through each paragraph in the file and build a directed
#     acyclic graph (DAG). If it's a quoted paragraph, search the
#     DAG for the quoted paragraph, and point the following paragraph's node
#     at it. If it's a normal paragraph, point it at the preceding
#     paragraph's node.
# (3) Do a topological sort on the DAG and spit out the paragraphs
#     in order.
  
@Nodes = ();     
my $topnode = &makenode("","");
foreach $grp (keys %Groups) {
  print "Writing proto turn for '$grp' group\n";
  print OUT "<<$grp>>\n";
  @grp = split(",",$Groups{$grp});
  foreach $file (@files) {
    foreach $name (@grp) {
	next if $gm && $name =~ /gm/i;
	$gm++ if $name =~ /gm/i;
	  if ($file =~ /^${name}(\d)*-/i) {
		print STDERR "  Checking out $name ($file)\n";
		# 1. Read file, detag, throw out quoted paras before
                # other quoted paras
		my @paras = &preprocess($file);
		# 2. Go through each para and either build a DAG node
                # for it (if it's not quoted), or find the DAG node for
                # for it (if it's quoted). If we've found a node,
                # remember it. If we've built one, point it at whatever
                # we last found (and reset to our new node) or the last node
                # (and reset that to our new node)
                # Quit if we hit "-- "
		my $lastquoted = "";
  		my $lastpara = "";
		my $para;
		foreach $para (@paras) {
	          if ($para =~ /^\s*>/) {
		    # A quoted paragraph. Try to find its node
		    $lastquoted = &findnode(\@Nodes,$para);
		    &drawedge($lastquoted,$lastpara,0) if ($lastquoted and $lastpara);
		  } else {
		    # A normal paragraph. Build a node and point it
                    # at lastquoted if possible, lastpara if not,
                    # and topnode as a last resort.
		    my $node = &makenode($para,$name);
		    if ($lastquoted) {
			&drawedge($node,$lastquoted,1);
			undef($lastquoted);
			push(@Quoted,$node);
		    } elsif ($lastpara) {
			&drawedge($node,$lastpara,0);
  		    	push(@Nodes,$node);
		    } else {
			# Must be the very first node.
			&drawedge($node,$topnode,0);
  		    	push(@Tops,$node);
		    }
		    $lastpara = $node;
                }
              }
	  }
        }
  }
  # We want to be sure that everyone's move happens roughly in
  # parallel, and that quoting is a tighter binding than simply
  # other following paragraphs. So we force the topological sort
  # to go through nodes connected to the top node, then nodes
  # that are after quoted paragraphs, then other nodes.
  @Nodes = (@Tops,@Quoted,@Nodes);
  # 3. Toposort the DAG and spit out the paragraphs
  @Nodes = &topological_sort(\@Nodes);
  &nodeprint(@Nodes);
  # 4. Clear our DAG here so we start clean.
  undef(@Nodes);
  undef(@Quoted);
  undef(%Edges);
}

exit 0;

# Given an html file, read it in, removing tags
# Then remove all but the last quoted paragraph in any series of
# quoted paragraphs.
sub preprocess {
  my $file = shift;
  my @lines;
  open(HTML,$file) or die "Unable to open $file\n";
  my($last,$lastp,$lastq);
  my($header_in,$header_done,$body_in);
  while (defined($_ = <HTML>)) {
    # Detag
    $body_in = 1 if /<body>/i;
    s/<[^<>]+>//g;
    s/&gt;/>/g;
    s/&lt;/</g;
    s/&amp;/&/g;
    unless ($header_done) {
      $header_in = 1 if ($body_in and /^\w+:/);
      $header_done = 1 if ($header_in and /^$/);
      next;
    }
    last if /^--\s*$/;
    next if $_ eq $last;
    # Did we just see a blank line? If so, we're starting a new paragraph.
    if ($last =~ /^[>\s]*$/) {
      # We're starting a new paragraph. If it's not a quoted paragraph,
      # add our last quoted paragraph in.
      push(@lines,@quoted,"\n") if (! /^\s*>[>\s]*/ and @quoted);
      # Toss our last quoted paragraph either way.
      @quoted = ();
    } 
    if (/^\s*>[>\s]*/) {
      # We're in a quoted paragraph. Store it up.
      push(@quoted,$_) unless /^[>\s]*$/;
    } else {
      # We're in a normal paragraph. Add it.
      push(@lines,$_) unless $_ eq $lastp;
      $lastp = $_;
    }
    $last = $_; 
  }
  # Now join together paragraphs. We preserve the \n's, etc.
  my @paras;
  my $para;
  while ($_ = shift(@lines)) {
    if (/^$/) {
      push(@paras,$para) if $para;
      $para = ""; 
    }
    $para .= $_;
  }
  push(@paras,$para) if $para !~ /^$/;
  return @paras;
} 

sub makenode {
  my $data = shift;
  my $speaker = shift;
  my $node = new Graph::Node;
  $node->setAttribute('speaker',$speaker);
  $node->setAttribute('text',$data);
  return $node;
}

# A simple linear search for a node. The target is given in quoted
# form and we want to find something that looks the same, but unquoted.
sub findnode {
  my $nodelistref = shift;
  my $target = shift;
  my $node;
  foreach $node (@$nodelistref) {
    return $node if &quotematch($target,$node->getAttribute('text'));
  }
  # Oops, didn't find anything. Maybe this is quoting an earlier turn
  # or something
  return undef;
}

sub quotematch {
  my($quoted,$text) = @_;
  my $escquoted = "\Q$quoted\E";
  $escquoted =~ s/\\\n/.*/gs;
  return 1 if $text =~ /$escquoted/is;
  my $esctext = "\Q$text\E";
  $esctext =~ s/\\\n/.*/gs;
  return 1 if $quoted =~ /$esctext/is;
  return 0;
}


# Perform a depth-first search of the DAG. As each node is finished,
# add it to the front of a list which we return. This list is
# be topologically sorted.
sub topological_sort {
  local($time) = 0;
  my $nodelistref = shift;
  my @sorted_list;
  my $node;
  foreach $node (@$nodelistref) {
    $node->setAttribute('color','white');
  }
  foreach $node (@$nodelistref) {
    &visitnode($node) if ($node->getAttribute('color') eq 'white');
  }
  return sort byfinished @$nodelistref;
}

sub visitnode {
   my $node = shift;
     
   $time++; 
   $node->setAttribute('color','black');
   my $edge;
   foreach $edge (@{$Edges{$node}}) {
	my $child = $edge->getAttribute('TO');
        if ($child->getAttribute('color') eq 'white') {
          &visitnode($child);
        }
   }
   $time++;
   $node->setAttribute('finished',$time);
}

sub byfinished {
  return $a->getAttribute('finished') <=> $b->getAttribute('finished');
}

sub drawedge {
  my $from = shift;
  my $to = shift;
  my $quoted = shift;
  my $edge = new Graph::Edge('FROM' => $from, 'TO' => $to);
  if ($quoted) {
    unshift(@{$Edges{$from}},$edge);
  } else {
    push(@{$Edges{$from}},$edge);
  }
}

# Print out a list of nodes
sub nodeprint {
  my @nodes = @_;
  my $lastspeaker;
  my $speaker;
  my $node;
  foreach $node (@nodes) {
     $speaker = $node->getAttribute('speaker');
     print OUT "\n<<< $lastspeaker\n\n" 
        if ($lastspeaker and $speaker ne $lastspeaker);
     print OUT ">>> $speaker\n\n" if $speaker ne $lastspeaker;
     print OUT $node->getAttribute('text');
     $lastspeaker = $speaker;
  }
}
 
!NO!SUBS!
chmod 755 catmoves
$eunicefix catmoves
