#! /usr/bin/perl 

## This file is part of Babble.  All files in the distribution of Babble
## are Copyright 2000 by
## 
##     Alva L.  Couch, 
##     Associate Professor of Computer Science, 
##     Tufts University, Medford MA 02155
##     email: couch@eecs.tufts.edu
##     phone: 617-627-3674
## 
## All rights reserved.
##  
## Redistribution and use are permitted provided that this entire
## copyright notice is duplicated in all such copies, and that any
## documentation, announcements, and other materials related to such
## distribution and use acknowledge that the software was developed by
## Alva L.  Couch at Tufts University in Medford, Massachusetts, USA.
## No charge, other than an "at-cost" distribution fee, may be charged
## for copies, derivations, or distributions of this material without
## the express written consent of the copyright holder.  Neither the
## name of the University nor the names of the authors may be used to
## endorse or promote products derived from this material without
## specific prior written permission.  THIS SOFTWARE IS PROVIDED ``AS
## IS'' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
## WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
## FITNESS FOR ANY PARTICULAR PURPOSE.

use Data::Dumper; 
use Getopt::Long; 
use strict; 
no strict "refs"; 
# require "babble.pl"; 

$main::debug=0; 
$main::trace=0; 
$main::inform=1; 
$main::xmlout=undef; 
$main::rawout=undef; 

$main::debugfile = 'STDERR'; 
$main::tracefile = 'STDERR'; 
$main::informfile = 'STDERR'; 
$main::xmloutfile = 'STDERR'; 
$main::rawoutfile = 'STDERR'; 

$main::xmloutfilename = 'xml.out'; 
$main::rawoutfilename = 'raw.out'; 

# open(DEBUG,">debug.out") or die "can't write debug.out"; 

# schedule signal handlers that will close open streams
$main::SIG{'INT'}  = \&main::shut; 
$main::SIG{'QUIT'} = \&main::shut; 
$main::SIG{'__DIE__'} = \&main::shut; 

# get options
$main::result = GetOptions(
  "help"           => \$main::help, 
  "debug=i"        => \$main::debug, 
  "debugfile=s"    => \$main::tracefilename, 
  "trace=i"        => \$main::trace, 
  "tracefile=s"    => \$main::tracefilename, 
  "errorfile=s"    => \$main::informfilename, 
  "xmlout=i"       => \$main::xmlout, 
  "xmloutfile=s"   => \$main::xmloutfilename, 
  "rawout=i"       => \$main::rawout, 
  "rawoutfile=s"   => \$main::rawoutfilename, 
  "invoke=s"       => \$main::invoke, 
  "bind=s"         => \$main::bind, 
  "spawn=s"        => \$main::spawn, 
  "converse=s"     => \$main::converse, 
  "conversefile=s" => \$main::conversefile, 
); 

if ($main::help || ! $main::result) { 
  &help;
  exit 1; 
} 

if (defined $main::converse) { 
   print STDERR "Entering a conversation with command '$main::converse'\n"; 
   print STDERR "Type EOF (control-D) to exit\n"; 
   $main::cmd=new Spawn($main::converse); 
   exit 1 if ! defined $main::cmd; 
   $main::ret = $main::cmd->converse(); 
   $main::com = $main::converse; 
   $main::com =~ s/'/\\'/g; 
   $main::ret = "<stream>\n<brook name='main'>\n<spawn command='$main::com'>\n"
        . $main::ret . "</spawn>\n</brook>\n</stream>\n"; 
   $main::cmd->close(); 
   $main::conversefile = "./converse.out" if ! defined $main::conversefile; 
   print STDERR "Writing XML output to '$main::conversefile'\n"; 
   open(OUT,">$main::conversefile") or die "can't write $main::conversefile: $!"; 
   print OUT $main::ret; 
   close OUT; 
   print STDERR "Done!\n"; 
   exit 0; 
} 

$main::file = shift @ARGV; 
if ($main::file eq '') { 
   print STDERR "no file specified!\n"; 
   &help; 
   exit 1; 
} 

if ($main::debug>0 && $main::debugfilename ne '') { 
   open(DEBUG,">$main::debugfilename") 
	or die "can't open $main::debugfilename: $!"; 
   $main::debugfile = 'DEBUG'; 
   &debug("Babble started " . localtime(time) . "\n"); 
} 

if ($main::trace>0 && $main::tracefilename ne '') { 
   open(TRACE,">$main::tracefilename") 
	or die "can't open $main::tracefilename: $!"; 
   $main::tracefile = 'TRACE'; 
   &trace("Babble started " . localtime(time) . "\n"); 
} 

if ($main::inform>0 && $main::informfilename ne '') { 
   open(INFORM,">$main::informfilename") 
	or die "can't open $main::informfilename: $!"; 
   $main::informfile = 'INFORM'; 
   &inform("Babble started " . localtime(time) . "\n"); 
} 

if ($main::xmlout>0 && $main::xmloutfilename ne '') { 
   open(XMLOUT,">$main::xmloutfilename") 
	or die "can't open $main::xmloutfilename: $!"; 
   $main::xmloutfile = 'XMLOUT'; 
   &main::xmlout("<output source='babble' date='" . localtime(time) . "'>\n"); 
} 

if ($main::rawout>0 && $main::rawoutfilename ne '') { 
   open(RAWOUT,">$main::rawoutfilename") 
	or die "can't open $main::rawoutfilename: $!"; 
   $main::rawoutfile = 'RAWOUT'; 
   &rawout("output source='babble' date='" . localtime(time) . "'\n"); 
} 

if (defined $main::spawn) { 
   $main::cmd = new Spawn ($main::spawn);
   exit 1 if ! defined $main::cmd; 
} else { 
   $main::cmd = undef; 
} 

if (defined $main::bind) { 
   $main::bnd = newFile SMscope($main::bind); 
   exit 1 if ! defined $main::bnd; 
} else { 
   # make an empty scope to start; can be bound later. 
   $main::bnd = new SMscope([],new SMfrstack(new SMframe({},'config','dynamic'))); 
} 

if (defined $main::invoke) { 
   $main::inv = $main::invoke; 
} else { 
   $main::inv = 'main'; 
} 

$main::doc = newFile SMelt($main::file); 		# open main file
$main::brook = $main::doc->brook($main::inv);		# look up routine to do
die "no main program!" if ! defined $main::brook; 
if ($main::doc->check($main::brook,$main::bnd)) {	# check for errors. 
    if (! $main::doc->do($main::brook,$main::cmd,$main::bnd)) { # if ok, actually do it. 
       &main::inform("Execution errors found; aborting execution!\n"); 
       exit 1; 
    } 
} else { 
   &main::inform("Compilation errors found; cancelling execution!\n"); 
   exit 1; 
} 
exit 0; 

sub help { 
   print STDERR <<EOF
Babble executes in two modes. In its primary mode, 
babble implements a documented stream of interactions. 
In another mode, it records a stream for future execution. 

Stream execution: $0 inputfile <options>
   In this mode, babble tries to interpret an input file as a 
   stream of interactions. Options can include: 
   --help                       print this message. 
   --errorfile=/path/to/file    redirect error outptu to file 
				(default STDERR)
   --debug=9                    set debug level (0-9)  
				(default 0) 
   --debugfile=/path/to/file    redirect debug trace to file 
				(default STDERR)
   --trace=9                    set execution trace level (0-9)
				(default 0) 
   --tracefile=/path/to/file    redirect execution trace to file 
				(default STDERR)
   --xmlout                     generate XML rendition of execution 
				(default OFF) 
   --xmloutfile=/path/to/file   redirect XML to given file 
				(default xml.out)
   --rawout                     record raw rendition of execution 
				(default OFF) 
   --rawoutfile=/path/to/file   redirect raw rendition to file 
				(default raw.out)
   --invoke=brookname           start invocation with the given brook
				(default 'main') 
   --bind=/path/to/file         read variants from file before execution 
				(default none) 
   --spawn="command to script"  make this command active before execution 
				(default none) 
Stream recording: $0 -converse="command to script" <options> 
   In this mode, babble tries to capture an interactive session 
   in a runnable form. Options may include: 
   --conversefile=/path/to/file redirect interactive capture to file 
				(default converse.out)
EOF
;
} 

# just die with an error message
# unneeded in modern Perls due to __DIE__ handler above
sub shutdie { 
   my $reason = shift; 
   &Spawn::clear; 
   die $reason; 
} 

# print help message and die
sub shut { 
   my $reason = shift; 
   &Spawn::clear; 
} 

# print a debugging write
sub debug { 
   my $mess = shift; 
   my $level = shift; 
   return if !$main::debug; 
   return if defined $level and $level>$main::debug; 
   print $main::debugfile $mess; 
} 

# print a trace (higher level than debugging) 
sub trace { 
   my $mess = shift; 
   my $level = shift; 
   return if !$main::trace; 
   return if defined $level and $level>$main::trace; 
   print $main::tracefile $mess; 
} 

# information can't be blocked. 
sub inform { 
   my $mess = shift; 
   my $level = shift; 
   return if !$main::inform; 
   return if defined $level and $level>$main::inform; 
   print $main::informfile $mess; 
} 

# xml output is utilized in further runs. 
sub xmlout { 
   my $mess = shift; 
   my $level = shift; 
   return if !$main::xmlout; 
   return if defined $level and $level>$main::xmlout; 
   print $main::xmloutfile $mess; 
} 

# raw output for debugging
sub rawout { 
   my $mess = shift; 
   my $level = shift; 
   return if !$main::rawout; 
   print $main::rawoutfile $mess; 
} 

#####
# this is an exception stack that holds SMelt data 
# and allows universal exception handling. 
# untested as yet. 
#####

package SMexcept; 

# this is ridiculous overkill, but may be needed. 
# each exception keeps an entire exception stack
# in the context of the exception, including 
# the stream to which it's registered. 
# this might of course be eliminated, 
# but it doesn't hurt. 

sub new { 
   my $pack = shift; 
   my $root = shift; 
   my $spawn = shift; 
   my $except = shift; 
   my $scope = shift; 
   my $type = shift; 
   return bless { 
	'except'=>$except, 
	'root'=>$root, 
	'spawn'=>$spawn, 
	'scope'=>$scope, 
	'type'=>$type }; 
} 

sub root { 
   my $self = shift; 
   return $self->{'root'}; 
} 

sub except { 
   my $self = shift; 
   return $self->{'except'}; 
} 

sub scope { 
   my $self = shift; 
   return $self->{'scope'}; 
} 

sub spawn { 
   my $self = shift; 
   return $self->{'spawn'}; 
} 

sub type { 
   my $self = shift; 
   return $self->{'type'}; 
} 

sub pattern { 
   my $self = shift; 
   return $self->root->do_cond_pattern(
       $self->except, $self->spawn, $self->scope, 0
   ); 
} 

sub do { 
   my $self = shift; 
   return $self->root->do_cond_content(
       $self->except, $self->spawn, $self->scope, 0
   ); 
} 

sub bind { 
   my $self = shift; 
   my $text = shift; 
   return $self->root->do_cond_bind(
       $self->except, $self->spawn, $self->scope, 0, $text
   ) ; 
} 

#####
# an exception stack contains all exceptions currently 
# in scope. They're pushed when discovered and popped when
# one moves out of scope. 
#####

package SMexstack; 
use Data::Dumper; 

# push new exception onto exception stack by creating new instance
sub new { 
   my $pack = shift; 
   my $except = shift; 	# [] at beginning, or current scope. 
   my $assoc = shift; 	# new associative array in scope. 
   my $ref = [@$except]; 
   push(@$ref,$assoc); 
   return bless $ref; 
} 

sub patterns { 
    my $self = shift; 
    my $i; 
    my $patterns = []; 
    for ($i=$#$self; $i>=0; $i--) { 
        my $val = $self->[$i]->pattern; 
        push(@$patterns,$val); 
    } 
    return $patterns; 
}

# invoke an exception based upon exception number
# this is an open-and-shut scope-chain change
# onto an exception scope chain, 
# that uses (possibly old) bindings. 
# it binds exception data into its source chain 
# and returns 1 or undef depending upon whether
# the exception handler completed or stalled. 
sub do { 
    my $self = shift; 
    my $no = shift;   # exception to invoke
    my $text = shift; # match text for binding algebra
    # first bind variables 
    $self->[$no]->bind($text); 
    # then do the thing, mercilessly. 
    return $self->[$no]->do; 
} 

#####
# a frame contains the variables available in one context
# these are kept in a frame stack SMfrstack where only the top frame
# is modified at any time. 
#####

package SMframe; 
use Data::Dumper; 

sub new { 
    my $pack = shift; 
    my $assoc = shift; 
    my $type = shift; 
    my $source = shift; 
    return bless {'values'=>$assoc, 'type'=>$type, 'source'=>$source}; 
} 

sub val { 
    my $self = shift; 
    my $name = shift; 
    return $self->{'values'}->{$name}; 
} 

sub values { 
    my $self = shift; 
    return $self->{'values'}; 
} 

sub set { 
    my $self = shift; 
    my $assoc = shift; 
    my $key; 
    my $value; 
    while (($key,$value)=each %$assoc) { 
        $self->{'values'}->{$key} = $value; 
    }
} 

sub source { 
    my $self = shift; 
    return $self->{'source'}; 
} 

sub type { 
    my $self = shift; 
    return $self->{'type'}; 
} 

sub hash { 
    my $self = shift; 
    &main::debug("hash " . (ref $self) . "\n",10); 
    my $out = {}; 
    my $k;
    my $v; 
    while (($k,$v) = each %{$self->{'values'}}) { 
        if (ref $v ne '') { 
           $out->{$k} = $v->hash ; 
        } else { 
           $out->{$k} = $v; 
        } 
    } 
    return $out; 
} 

#####
# a frame stack contains possibly multiple frames. 
# only the top one is modified to shadow the lower ones. 
# but the lower frames are read to default values. 
#####

package SMfrstack; 
use Data::Dumper; 

sub new { 
    my $pack = shift; 
    my @frames = @_; 
    return bless [@frames]; 
} 

sub val { 
    my $self = shift; 
    my $name = shift; 
    my $i; 
    for ($i=$#$self; $i>=0; $i--) { 
        my $val = $self->[$i]->val($name); 
        return $val if defined $val; 
    } 
    return undef; 
}

sub type { 
    my $self = shift; 
    return $self->[$#$self]->type; 
} 

sub set { 
    my $self = shift; 
    my $assoc = shift; 
    $self->[$#$self]->set($assoc); 
} 

sub push { 
    my $self = shift; 
    my $new = shift; 
    push(@$self,$new); 
} 

sub pop { 
    my $self = shift; 
    return pop(@$self); 
} 

sub orig { 
    my $self = shift; 
    my $name = shift; 
    return $self->[0]->val($name); 
} 

sub oldest { 
    my $self = shift; 
    my $name = shift; 
    my $i; 
    for ($i=0; $i<@$self; $i++) { 
        my $val = $self->[$i]->val($name); 
        return $val if defined $val; 
    }
    return undef; 
} 

sub keys { 
    my $self = shift; 
    my @indices = (); 
    my $i; 
    for ($i=0; $i<@$self; $i++) {
        my @newind = keys %{$self->[$i]->values}; 
	push(@indices,@newind); 
    } 
    @indices = sort @indices; 
    for ($i=1; $i<@indices; $i++) { 
        splice(@indices,$i,1) if $indices[$i] eq $indices[$i-1]
          or ! defined $indices[$i]; 
    } 
    return @indices; 
} 

sub dump { 
    my $self = shift; 
    my $indent = shift; 
    my $i; 
    my $out = ""; 
# $out .= &SMelt::spaces($indent) . "SMfrstack\n"; 
    # get the indices in a frame context
    my @indices = $self->keys; 
    for ($i=0; $i<@indices; $i++) { 
        my $val= $self->val($indices[$i]); 
	if (ref $val eq '') {
           $out .= &SMelt::spaces($indent)."<var name=\"".$indices[$i]
                ."\">".&SMelt::DumpString($self->val($indices[$i]))."</var>\n"; 
	} elsif (ref $val eq 'SMfrstack'
              or ref $val eq 'SMrestack') { 
	   $out .= &SMelt::spaces($indent)."<"
                  . $val->type . " name=\"".$indices[$i]."\">\n"; 
	   $out .= $val->dump($indent+1); 
	   $out .= &SMelt::spaces($indent)."</"
                  . $val->type . ">\n"; 
        } else { 
	   &main::inform("ignoring unknown ref type " . (ref $val) . "\n"); 
        } 
    } 
    return $out; 
} 

sub hash { 
    my $self = shift; 
    &main::debug("hash " . (ref $self) . "\n", 10); 
    my @keys = $self->keys; 
    my $i; 
    my $out = {}; 
    for ($i=0; $i<@keys; $i++) { 
       my $val = $self->val($keys[$i]); 
       if (ref $val ne '') { 
          $out->{$keys[$i]} = $val->hash; 
       } else { 
          $out->{$keys[$i]} = $val; 
       } 
    } 
    return $out; 
} 

#####
# a repeat context contains multiple bindings for
# the same (possibly defaulted) variables. 
# these are kept in an SMrestack repeat stack 
# in which only the newest version is modified
# while older versions are kept for error tracing. 
#####

package SMrepeat; 
use Data::Dumper; 

sub new { 
    my $pack = shift; 
    my $array = shift; 
    my $source = shift; 
    return bless {'array'=>$array, 'source'=>$source};  
} 

sub length { 
    my $self = shift; 
    my $array = $self->{'array'}; 
    return scalar(@$array); 
} 

sub instance { 
    my $self = shift; 
    my $no = shift; 
    return $self->{'array'}->[$no]; 
} 

sub type { return 'repeat'; } 

sub instanceByKey { 
    my $self = shift; 
    my $key = shift; 
    my $value = shift; 
    my $array = $self->{'array'}; 
    my $i; 
    for ($i=0; $i<@$array; $i++) { 
        return $array->[$i] if $array->[$i]->val($key) eq $value; 
    } 
    return undef; 
} 

sub dump { 
    my $self = shift; 
    my $indent = shift; 
    my $i; 
    my $array = $self->{'array'}; 
    my $out = ""; 
    for ($i=0; $i<@$array; $i++) { 
        $out .= &SMelt::spaces($indent) . "<instance>\n"; 
        $out .= $array->[$i]->dump($indent+1); 
        $out .= &SMelt::spaces($indent) . "</instance>\n"; 
    } 
    return $out; 
} 

sub iskey { 
    my $self = shift; 
    my $key = shift; 
    my @out = $self->range($key); 
    @out = sort @out; 
    my $i; 
    for ($i=0; $i<@out; $i++) { 
       # return undef if ! defined $out[$i]; 
       return undef if $i>0 and $out[$i] eq $out[$i-1]; 
    } 
    return 1; 
} 

# construct an array of all string values of a thing
# within an iteration context
sub range { 
    my $self = shift; 
    my $key = shift; 
    my @out = (); 
    my $array = $self->{'array'}; 
    my $count = scalar(@$array); 
    my $i; 
    for ($i=0; $i<$count; $i++) { 
	my $stuff = $array->[$i]->val($key); 
        push(@out,$stuff);
    } 
    return @out; 
} 

sub hash { 
    my $self = shift; 
    &main::debug("hash " . (ref $self) . "\n",10); 
    my $out = []; 
    my $i; for ($i=0; $i<$self->length; $i++) { 
       my $inst = $self->instance($i); 
       if (ref $inst ne '') { 
          push(@$out, $inst->hash); 
       } else { 
          push(@$out, $inst); 
       } 
    } 
    return $out; 
} 

#####
# a repeat stack contains possibly multiple repeat contexts. 
# only the top one is ever accessed or modified.
# this is mainly to keep track of differences between 
# static and dynamic variables and has no execution significance. 
#####

package SMrestack; 
use Data::Dumper; 

sub new { 
    my $pack = shift; 
    my @frames = @_; 
    return bless [@frames]; 
} 

sub top { 
    my $self = shift; 
    return $self->[$#$self]; 
} 

sub instance { 
    my $self = shift; 
    my $no = shift; 
    return $self->top->instance($no); 
} 

sub instanceByKey { 
    my $self = shift; 
    my $key = shift; 
    my $value = shift; 
    return $self->top->instanceByKey($key,$value); 
} 

sub range { 
    my $self = shift; 
    my $key = shift; 
    return $self->top->range($key); 
} 

sub iskey { 
    my $self = shift; 
    my $key = shift; 
    return $self->top->iskey($key); 
} 

sub length { 
    my $self = shift; 
    return $self->top->length; 
} 

sub dump { 
    my $self = shift; 
    my $indent = shift; 
    return $self->top->dump($indent); 
} 

sub push { 
    my $self = shift; 
    my $new = shift; 
    push(@$self,$new); 
} 

sub pop { 
    my $self = shift; 
    return pop(@$self); 
} 

sub origInstance { 
    my $self = shift; 
    my $no = shift; 
    return $self->[0]->instance($no); 
} 

sub origLength { 
    my $self = shift; 
    return $self->[0]->length; 
} 

sub type { return 'repeat'; } 

sub hash { 
    my $self = shift; 
    &main::debug("hash " . (ref $self) . "\n",10); 
    return $self->top->hash; 
} 

#####
# parsing of configuration data as XML. 
# this package parses XML specifications of configuration 
# data and returns an object that represents that configuration. 
# the member function 'mod' transforms this into an SMfrstack modification 
# context for access inside babble. 
#####

package SMconfig; 
use Data::Dumper; 
use XML::Parser; 

sub new { 
   my $pack = shift; 
   my $xml = shift; 
   $SMconfig::toplevel = []; 
   $SMconfig::stack = []; 
   my $xp = new XML::Parser(Handlers => {Start => \&handle_start,
                                         End   => \&handle_end,
                                         Char  => \&handle_char}, 
                            ErrorContext => 3);
   $xp->parse($xml); 
   return bless $SMconfig::toplevel->[0]; 
} 

sub newFile {
   my $pack = shift; 
   my $file = shift; 
   $SMconfig::toplevel = []; 
   $SMconfig::stack = []; 
   my $xp = new XML::Parser(Handlers => {Start => \&handle_start,
                                         End   => \&handle_end,
                                         Char  => \&handle_char}, 
                            ErrorContext => 3);
   my $content = &readFileAndEscape($file);
   $xp->parse($content); 
   return bless $SMconfig::toplevel->[0]; 
} 

sub newStdin {
   my $pack = shift; 
   $SMconfig::toplevel = []; 
   $SMconfig::stack = []; 
   my $xp = new XML::Parser(Handlers => {Start => \&handle_start,
                                         End   => \&handle_end,
                                         Char  => \&handle_char},
                            ErrorContext => 3);
   my $content = &readStdinAndEscape();
   $xp->parse($content); 
   return bless $SMconfig::toplevel->[0]; 
} 

sub tagname { 
   my $self = shift; 
   return $self->{'tagname'}; 
} 

sub attrs { 
   my $self = shift; 
   my $name = shift; 
   return $self->{'attrs'}->{$name} if defined $name; 
   return $self->{'attrs'}; 
} 

sub content { 
   my $self = shift; 
   return $self->{'content'}; 
} 

sub startline { 
   my $self = shift; 
   return $self->{'startline'}; 
} 

sub endline { 
   my $self = shift; 
   return $self->{'endline'}; 
} 

sub startcol { 
   my $self = shift; 
   return $self->{'startcol'}; 
} 

sub endcol { 
   my $self = shift; 
   return $self->{'endcol'}; 
} 

#####
# this mines variant structure out of XML recursively, 
# starting at the top of the variant space and 
# descending as needed. The result is an SMfrstack
# containing a free mix of scalars, SMrestack's, and
# SMcase's
#####

sub mod { 
   my $self = shift; 
   if ($self->tagname eq 'config') { 
      my $config = &mod_aux($self->content); 
      return new SMfrstack (
          (new SMframe($config,'config','static')),
          (new SMframe({},'config','dynamic'))
      ); 
   } else { 
      die "vars can only be extracted from <config> elements!"; 
   }
} 

# recursively descend into variable declarations parsing substructure
# this is a matter of distinguishing point and instance variables. 
sub mod_aux { 
   my $content = shift; 
   my $i; 
   my $stuff = {}; 
   for ($i=0; $i<@$content; $i++) {
      my $thing = $content->[$i]; 
      if (ref $thing ne "SMconfig") { 
	 &main::inform("ignoring garbage $thing in file!\n"); 
      } elsif ($thing->tagname eq 'var') { 
         if (defined $thing->attrs->{'name'} ) { 
	    $stuff->{$thing->attrs->{'name'}} =  &varContent($thing->content); 
	 } else { 
	    &main::inform("no name for var!\n"); 
         } 
      } elsif ($thing->tagname eq 'case') { 
         if (defined $thing->attrs->{'name'} ) { 
	    $stuff->{$thing->attrs->{'name'}} =  &caseContent($thing->content); 
	 } else { 
	    &main::inform("no name for case!\n"); 
         } 
      } elsif ($thing->tagname eq 'repeat') { 
         if (defined $thing->attrs->{'name'} ) { 
	    $stuff->{$thing->attrs->{'name'}} =  &repeatContent($thing->content); 
	 } else { 
	    &main::inform("no name for repeat!\n"); 
         } 
      } else {
 	 &main::inform("invalid tagname '".$thing->tagname."' !\n"); 
      } 
   } 
   return $stuff; 
} 

#####
# a var must contain only a string 
#####

sub varContent { 
   my $content = shift; 
   my $result = ""; 
   my $i; 
   for ($i=0; $i<@$content; $i++) { 
      if (ref $content->[$i] eq '') { 
	  $result .= $content->[$i]; 
      } else { 
	  &main::inform("improper tag '" 
	    . ref $content->[$i] 
	    . "' inside text content!\n"); 
      } 
   } 
   return $result; 
} 

#####
# a repeat can contain only instances
#####

sub repeatContent { 
   my $content = shift; 
   my $i; 
   my $result = []; 
   for ($i=0; $i<@$content; $i++) { 
      if (ref $content->[$i] eq 'SMconfig') { 
	 if ($content->[$i]->tagname eq 'instance') { 
	    push(@{$result}, &instanceContent($content->[$i]->content)); 
	 } else { 
	    &main::inform("improper tagname '" 
	       . $content->[$i]->tagname
               . "' inside repeat!\n"); 
	 } 
      } else { 
	 &main::inform("garbage '" . $content->[$i] . " in repeat content!\n"); 
      } 
   }
   return (new SMrestack(new SMrepeat ($result,'static'))); 
} 

#####
# an instance can contain repeats, cases, and vars. 
#####

sub instanceContent { 
   my $content = shift; 
   my $i; 
   my $result = {}; 
   for ($i=0; $i<@$content; $i++) { 
     
      if (ref $content->[$i] ne 'SMconfig') { 
	 &main::inform("garbage '" . $content->[$i] . "' in instance!\n"); 
         next; 
      } 
      my $thing = $content->[$i]; 
      my $tagname = $thing->tagname; 
      my $name = $thing->attrs('name'); 
      if (! defined $name) { 
	 &main::inform("unnamed tag '" . $tagname . "' in instance!\n"); 
         next; 
      } 
      if ($tagname eq 'repeat') {
         $result->{$name} = &repeatContent($thing->content); 
      } elsif ($tagname eq 'case') { 
         $result->{$name} = &caseContent($thing->content); 
      } elsif ($tagname eq 'var') { 
         $result->{$name} = &varContent($thing->content); 
      } else { 
	    &main::inform("improper tagname '" 
		. $thing->tagname. "' in instance!\n"); 
      } 
   }
   return new SMfrstack (
       (new SMframe($result,'instance','static')),
       (new SMframe({},'instance','dynamic'))
   ); 
} 

#####
# parse content out of a case statement
# a case can contain repeats, cases, and vars. 
#####

sub caseContent { 
   my $content = shift; 
   my $i; 
   my $result = {}; 
   for ($i=0; $i<@$content; $i++) { 
     
      if (ref $content->[$i] ne 'SMconfig') { 
	 &main::inform("garbage '" . $content->[$i] . "' in case!\n"); 
         next; 
      } 
      my $thing = $content->[$i]; 
      my $tagname = $thing->tagname; 
      my $name = $thing->attrs('name'); 
      if (! defined $name) { 
	 &main::inform("unnamed tag '" . $tagname . "' in case!\n"); 
         next; 
      } 
      if ($tagname eq 'repeat') {
         $result->{$name} = &repeatContent($thing->content); 
      } elsif ($tagname eq 'case') {
         $result->{$name} = &caseContent($thing->content); 
      } elsif ($tagname eq 'var') { 
         $result->{$name} = &varContent($thing->content); 
      } else { 
	    &main::inform("improper tagname '" 
	       . $thing->tagname. "' in case!\n"); 
      } 
   }
   return new SMfrstack (
       (new SMframe($result,'case','static')),
       (new SMframe({},'case','dynamic'))
   ); 
} 

#####
# these (private) routines comprise part of the parser
# and react to opening, closing, and text parsing events. 
#####

sub handle_start { 
   my $expat = shift; 
   my $tagname = shift; 
   my %attrs = @_; 
   &main::debug("handle_start '$tagname'\n",10); 
   my $entry = bless {
       'tagname'=>$tagname,
       'attrs'=>{%attrs},
       'content'=>[],
       'startline'=>$expat->current_line, 
       'startcol'=>$expat->current_column, 
   }; 
   if (@$SMconfig::stack) { 
      push(@{$SMconfig::stack->[$#SMconfig::stack]->{'content'}},$entry); 
   } else { 	# no stack yet => an object at top level. Must be one of these.
      push(@$SMconfig::toplevel,$entry); 
   } 
   push(@$SMconfig::stack,$entry); 
} 

sub handle_end { 
   my $expat = shift; 
   my $tagname = shift; 
   &main::debug("handle_end '$tagname'\n",10); 
   if ($tagname ne $SMconfig::stack->[$#SMconfig::stack]->{'tagname'}) { 
      die "<$SMconfig::stack->[$#SMconfig::stack]->{'tagname'}> closed by </$tagname>!"; 
   } else { 
      ${$SMconfig::stack}[$#{SMconfig::stack}]->{'endline'}
	 =$expat->current_line; 
      ${$SMconfig::stack}[$#{SMconfig::stack}]->{'endcol'}
	 =$expat->current_column; 
      pop(@$SMconfig::stack); 
   } 
} 

sub handle_char { 
   my $expat = shift; 
   my $chars = shift; 
   &main::debug("handle_char '$chars'\n",10); 
   $chars =~ s/[\s\r\n]//g; 
   $chars =~ s/\\s/ /g; 
   $chars =~ s/\\t/\t/g; 
   $chars =~ s/\\r/\r/g; 
   $chars =~ s/\\n/\n/g; 
   $chars =~ s/\\\\/\\/g; 
   while ($chars =~ /(\\[0-9][0-9][0-9])/) { 
        my $replace = $1; 
        my $val = substr($replace,1,1)*8*8
                + substr($replace,2,1)*8
                + substr($replace,3,1); 
	&main::debug("replacing $replace with chr($val)\n",11); 
	$val = chr($val); 
	$chars =~ s/\\([0-9][0-9][0-9])/$val/; 
   } 
   return if $chars eq ''; 
   if (@$SMconfig::stack) { 
      my $place = $SMconfig::stack->[$#SMconfig::stack]->{'content'}; 
      if (@$place and ref $place->[$#$place] ne 'SMconfig') { 
         $place->[$#$place] .= $chars; 
      } else { 
         push(@{$SMconfig::stack->[$#SMconfig::stack]->{'content'}},$chars); 
      } 
   } else { 
      push(@$SMconfig::toplevel,$chars); 
   } 
} 

# read a variant declaration file and escape it.
# since there's no embedded Perl in data, 
# there's no escaping to do....

sub readFileAndEscape { 
   my $file = shift; 
   die "file $file doesn't exist!" if ! -e $file; 
   die "file $file isn't readable!" if ! -r $file; 
   open(FILE,"<$file") or die "can't read file: $!"; 
   my @stuff = (<FILE>); close FILE; 
   shift(@stuff) if $stuff[0] =~ /^#!/;
   return join('', @stuff); 
} 

sub readStdinAndEscape { 
   my @stuff = (<STDIN>); 
   shift(@stuff) if $stuff[0] =~ /^#!/;
   return join('', @stuff); 
} 

#####
# this implements dynamic scope chains, which are stacks of SMfrstack's
# one adds new values to the top chain element, but fetches values from 
# all chain elements. All subelements are SMfrstack's. 
# the stack substructure is mainly for debugging and tracing; 
# it is not needed for execution. 
#####

package SMscope; 
use Data::Dumper; 

sub new { 
   my $pack = shift; 
   my $scope = shift; 	# [] at beginning, or current scope. 
   my $assoc = shift; 	# new associative array in scope. 
   my $ref = [@$scope]; 
   push(@$ref,$assoc); 
   return bless $ref; 
} 

sub newFile { 
   my $pack = shift; 
   my $file = shift; 
   my $config = newFile SMconfig($file);
# print STDERR "config is " . Dumper($config);
   my $mod = $config->mod;
# print STDERR "mod is " . Dumper($mod);
   return new SMscope([],$mod);
} 

sub newStdin { 
   my $pack = shift; 
   my $config = newStdin SMconfig();
# print STDERR "config is " . Dumper($config);
   my $mod = $config->mod;
# print STDERR "mod is " . Dumper($mod);
   return new SMscope([],$mod);
} 

sub push { 
   my $self = shift; 
   my $assoc = shift; 
   push(@$self,$assoc); 
} 

sub pop { 
   my $self = shift; 
   return pop (@$self); 
} 

# get a value from an associative structure. 
sub val { 
   my $self = shift; 
   my $name = shift; 
   my $i; 
   for ($i= $#$self; $i>=0; $i--) { 
      my $val = $self->[$i]->val($name); 
      return $val if defined $val; 
   } 
   return undef; 
} 

# set a value in the toplevel scope. 
sub set { 
   my $self = shift; 
   my $assoc = shift; 
   $self->[$#$self]->set($assoc); 
} 

# get all keys available in this scope
sub keys { 
    my $self = shift; 
    my @indices = (); 
    my $i; 
    for ($i=0; $i<@$self; $i++) {
        my @newind = $self->[$i]->keys; 
	push(@indices,@newind); 
    } 
    @indices = sort @indices; 
    for ($i=1; $i<@indices; $i++) { 
        splice(@indices,$i,1) if $indices[$i] eq $indices[$i-1]
          or ! defined $indices[$i]; 
    } 
    return @indices; 
} 

sub dump { 
    my $self = shift; 
    my $indent = shift; 
    my $i; 
    my $out = ""; 
# $out .= &SMelt::spaces($indent) . "SMscope\n"; 
    # get the indices in a frame context
    my @indices = $self->keys; 
    $out .= &SMelt::spaces($indent) . "<config>\n"; 
# now we have a unique list of indices; print out their values
    for ($i=0; $i<@indices; $i++) { 
        my $val= $self->val($indices[$i]); 
	if (ref $val eq '') {
           $out .= &SMelt::spaces($indent+1)."<var name=\"".$indices[$i]
                ."\">".&SMelt::DumpString($self->val($indices[$i]))."</var>\n"; 
	} elsif (ref $val eq 'SMfrstack') { 
	   $out .= &SMelt::spaces($indent+1)."<"
                  . $val->type . " name=\"".$indices[$i]."\">\n"; 
	   $out .= $val->dump($indent+2); 
	   $out .= &SMelt::spaces($indent+1)."</"
                  . $val->type . ">\n"; 
        } elsif (ref $val eq 'SMrestack') { 
	   $out .= &SMelt::spaces($indent+1)."<"
                  . $val->type . " name=\"".$indices[$i]."\">\n"; 
	   $out .= $val->dump($indent+2); 
	   $out .= &SMelt::spaces($indent+1)."</"
                  . $val->type . ">\n"; 
        } else { 
	   &main::inform("ignoring unknown ref type " . (ref $val) . "\n"); 
        } 
    } 
    $out .= &SMelt::spaces($indent) . "</config>\n"; 
    return $out; 
} 

#####
# XML parser for the stream structure markup language
# input is an XML document; output is a parse tree containing all elements. 
# unlike SMconfig, which is transformed into SMscope's before being used, 
# the SMelt hierarchy is interpreted directly by babble, in place.
#####

package SMelt; 
use Data::Dumper; 
use XML::Parser; 

sub new { 
   my $pack = shift; 
   my $xml = shift; 
   $SMelt::toplevel = []; 
   $SMelt::stack = []; 
   my $xp = new XML::Parser(Handlers => {Start => \&handle_start,
                                         End   => \&handle_end,
                                         Char  => \&handle_char},
                            ErrorContext => 3);
   $xp->parse($xml); 
   return bless $SMelt::toplevel->[0]; 
} 

sub newFile {
   my $pack = shift; 
   my $file = shift; 
   $SMelt::toplevel = []; 
   $SMelt::stack = []; 
   my $xp = new XML::Parser(Handlers => {Start => \&handle_start,
                                         End   => \&handle_end,
                                         Char  => \&handle_char},
                            ErrorContext => 3);
   my $content = &readFileAndEscape($file);
   $xp->parse($content); 
   return bless $SMelt::toplevel->[0]; 
} 

sub newStdin {
   my $pack = shift; 
   $SMelt::toplevel = []; 
   $SMelt::stack = []; 
   my $xp = new XML::Parser(Handlers => {Start => \&handle_start,
                                         End   => \&handle_end,
                                         Char  => \&handle_char}, 
                            ErrorContext => 3);
   my $content = &readStdinAndEscape();
   $xp->parse($content); 
   return bless $SMelt::toplevel->[0]; 
} 

sub tagname { 
   my $self = shift; 
   return $self->{'tagname'}; 
} 

sub attrs { 
   my $self = shift; 
   my $name = shift; 
   return $self->{'attrs'}->{$name} if defined $name; 
   return $self->{'attrs'}; 
} 

sub content { 
   my $self = shift; 
   return $self->{'content'}; 
} 

sub startline { 
   my $self = shift; 
   return $self->{'startline'}; 
} 

sub endline { 
   my $self = shift; 
   return $self->{'endline'}; 
} 

sub startcol { 
   my $self = shift; 
   return $self->{'startcol'}; 
} 

sub endcol { 
   my $self = shift; 
   return $self->{'endcol'}; 
} 

# locate a specific brook within the SMelt hierarchy by direct search. 
sub brook { 
   my $self = shift; 
   my $bname = shift; 
   my $thing; 
   foreach $thing (@{$self->content}) { 
      return $thing 
         if ref $thing eq 'SMelt' 
         and $thing->tagname eq 'brook' 
         and $thing->attrs('name') eq $bname; 
   } 
   return undef; 
} 

#####
# TYPE CHECKING SUBSYSTEM
# this set of related routines validate type flow of a specific brook
# before allowing execution. The method of validation is to 
# perform an all-statements traversal of the SMelt hierarchy 
# checking for type contravariance violations of several kinds. 
#####

#####
# check a tree of streamstuff doing dynamic rescoping as necessary
# this requires passing a binding stack down 
# as one recurses into insert clauses 
# any inconsistencies are reported to the user via STDERR
#####

sub inform { 
   my $thing = shift; 
   my $indent = shift; 
   my $mess = shift; 
   my $level = shift; 
   &main::inform(&spaces($indent)."between lines "
	.$thing->{'startline'}.' and '.$thing->{'endline'}.":\n"); 
   &main::inform(&spaces($indent).$mess,$level); 
} 

sub trace { 
   my $thing = shift; 
   my $indent = shift; 
   my $mess = shift;  
   my $level= shift;  
   &main::trace(&spaces($indent).$mess,$level); 
} 

sub check {
   my $whole = shift; 
   my $thing = shift; 
   my $scope = shift; 
   my $indent = shift; 
   $indent=0 if ! defined $indent; 
   my $ret = 1; # return value

   if (ref $thing ne 'SMelt') {
      if ($thing !~ /^[\s\n]*$/) {
         &main::inform(&spaces($indent+1)
           . "unexpected literal \'$thing\' ignored in ssml\n"); 
      }
      return 1;
   }

   &main::debug(&spaces($indent). "begin check $thing->{'tagname'}\n",1); 
   
   if ($thing->tagname eq 'brook') {
      my $ret = $whole->check_content($thing->content,$scope,$indent+1);
      goto out; 

   } elsif ($thing->tagname eq 'get') {
      my $pat = $thing->getPattern($indent); 
      &main::debug(&spaces($indent+1)."get /" . $pat->[0] . "/\n",2); 
      &main::debug(&spaces($indent+1)." vars (". join(",",@{$pat->[1]}).")\n",2); 
      my $res = &dummyGetPattern("",$pat); 

      # here any variables are bound.
      &main::debug(&spaces($indent+1)."get bindings:\n",2);
      my $key; my $value;
      while (($key,$value) = each %$res) {
	 &main::debug(&spaces($indent+2)."get: binding '$key' => '$value'\n",2);
      }
      $scope->set($res); 
      goto good; 

   } elsif ($thing->tagname eq 'put') { 
     my $lit = $thing->putLiteral ($scope,$indent); 
     goto bad if ! defined $lit; 
     my $pat = $thing->putPattern ($scope,$indent); 
     goto bad if ! defined $pat; 
     my $xml = $thing->putXML ($scope, $indent); 
# print STDERR "xml=$xml\n"; 
     goto bad if ! defined $xml; 
     &main::debug(&spaces($indent+1)."put \"" . &DumpString($lit) . "\"\n",2); 
     &main::debug(&spaces($indent+1) . "put /" . $pat . "/\n",2); 

     goto good; 

  } elsif ($thing->tagname eq 'case') {
      # do instance cases, one per whole content of case tag
      my $iname = $thing->attrs('instance');
      if (defined $iname) {
         my $instance = $scope->val($iname);
         if (defined $instance) {
            my $status = $whole->check_content(
               $thing->content,
               (new SMscope($scope,$instance)),
               $indent+1) ;
            goto bad if !$status;
            goto good;
         } else {
            &inform($thing,$indent+1,
                "required instance $iname not declared"
                . " -- skipping case!\n");
            goto bad;
         }
      } else {
         &inform($thing,$indent+1, 
	     "no case namespace given"
             . " -- skipping case!\n");
         goto bad; 
      }

   } elsif ($thing->tagname eq 'repeat') { 
     # do instance repeats, one per whole content of repeat tag
     my $iname = $thing->attrs('instances'); 
     if (defined $iname) { 
	my $instances = $scope->val($iname); 
	if (defined $instances and ref $instances eq 'SMrepeat') { 
	   my $i; 
	   for ($i=0; $i<$instances->length; $i++) { 
	      goto bad if ! $whole->check($thing,
			(new SMscope($scope,$instances->instance($i))),
			$indent+1) ; 
	   }
	} else {
           &inform($thing,$indent+1,
	       "required instances $iname not declared"
	       . "-- skipping repeat check!\n"); 
           goto bad; 
	}
     } else { 
           &inform($thing,$indent+1,
	       "no instances named"
	       . "-- skipping repeat check!\n"); 
           goto bad; 
     } 

   } elsif ($thing->tagname eq 'while') {
      # inductive discovery repeat
      my $iname = $thing->attrs('instances');
      if (defined $iname) {
         my $content = $thing->content;
         my $gnum;
         for ($gnum=0; $gnum<@$content; $gnum++) {
            last if ref $content->[$gnum] eq 'SMelt';
         }
         my $guard = $content->[$gnum];
         if ($gnum<@$content and defined $guard and ref $guard eq 'SMelt') {
            my @scopes = ();
            push(@scopes,
               new SMscope($scope,
                   new SMfrstack(new SMframe({},'while','dynamic')))
            );
            my $status = $whole->check($guard,$scopes[$#scopes],$indent+1); 
            goto bad if ! $status; 
            my $i; 
	    for ($i=$gnum+1; $i<@$content; $i++) {
	       my $status = $whole->check(
		  $content->[$i],
		  $scopes[$#scopes],
		  $indent+1);
	       last if ! $status; # break!
	    }
            # skip mining in case of successful completion. 
            goto good; 
         } else {
            &inform($thing,$indent+1, 
                "invalid guard tag in while -- skipping while!\n");
            goto bad; 
         }
      } else { 
         &inform($thing,$indent+1,
	     "no instances defined for while -- skipping!\n");
	 goto bad;
      } 

   } elsif ($thing->tagname eq 'perl') { 
      # do fake operations in order to test type conformality
      # but don't actually eval embedded perl
      $ret = &Sandbox::Control::fakeImport($scope,$thing->attrs('import')); 
      goto out if ! $ret; 
      $ret = &Sandbox::Control::fakeExport($scope,$thing->attrs('export')); 
      goto out;
   
   } elsif ($thing->tagname eq 'break') {
      goto good;   # unconditional stop unless inside while loop

   } elsif ($thing->tagname eq 'set') {
      # set a variable in the current scope to a value.

   } elsif ($thing->tagname eq 'test') {
      # test a variable value for some condition

   } elsif ($thing->tagname eq 'insert') { 
     my $brook = $thing->attrs('brook'); 
     if (defined $brook) { 
	my $bst = $whole->brook($brook); 
	if (defined $bst) { 
	   goto bad if ! $whole->check($bst,$scope,$indent+1) ; 
	} else { 
           &inform($thing,$indent+1,
	       "insert: no brook $brook defined!\n"); 
           goto bad; 
	} 
     } else { 
        &inform($thing,$indent+1,
	    "insert: no brook named!\n"); 
        goto bad; 
     }

# note: need to check more carefully for whether 
# branches have the correct structure. 
   } elsif ($thing->tagname eq 'junction') { 
      my $content = $thing->content;
      # first accumulate match patterns inside branches.
      my $i;
      my $branches = [];
      for ($i=0; $i<@$content; $i++) {
        my $branch = $content->[$i];
        if (ref $branch eq 'SMelt') {
           if ($branch->tagname eq 'branch') {
              my $bc = $branch->content;
              if ($bc->[0]->tagname eq 'get') {
                 push(@$branches,$branch);
              } else {
                 &inform($thing,$indent+1,
                     "ignoring branch whose first form isn't get!\n");
              }
           } else {
              my $tag = $branch->tagname;
              &inform($thing,$indent+1,
                  "non-branch '$tag' inside junction ignored!\n");
           }
        } else {
           &inform($thing,$indent+1,
               "non-tag data inside junction ignored!\n");
	} 
      } 
      # now create a get that'll select the appropriate branch:
      my $patterns = [];
      for ($i=0; $i<@$branches; $i++) {
        my $bc = $branches->[$i]->content;
        push(@$patterns,$bc->[0]->getPattern($indent)->[0]);
      }
      # and try to actually get it!
      for ($i=0; $i<@$patterns; $i++)  {
         &main::debug(&spaces($indent+1)
		    . "junction: option /$patterns->[$i]/\n",2);
      }
      # now check all branches in turn: 
      # OOPS! This binds all variables into this scope even though
      # only one actually alters it. This needs to check non-contravariance
      # of branch output in order to strictly check the script. 
      for ($i=0; $i<@$content; $i++) { 
         my $branch = $content->[$i]; 

         # first, bind variables from the get!
         goto bad if !$whole->check_cond_bind($branch,$scope,$indent);

         # then do the rest of the cond!
         goto bad if !$whole->check_cond_content($branch,$scope,$indent);
      } 
      goto good; 

# note: didn't check that mined values match in type with needs. 
# also need to instantiate one instance of list in order to 
# check that list is isomorphic with remove. 
# This would be better than calling remove on input, 
# because it's called on output of list. 

   } elsif ($thing->tagname eq 'converge') { # convergent scripting
      # mine out various subsections of the convergent process
      my $key = $thing->attrs('key');           # name of key within instance
      if (! defined $key) {
         &inform($thing,$indent+1,
             "no key for converge!\n");
         goto bad;
      }
      my $inst = $thing->attrs('instances');     # name of instance variable
      if (! defined $inst) {
         &inform($thing,$indent+1,
             "no repeat variable defined for converge!\n");
         goto bad;
      }
      my $add = undef;
      my $remove = undef;
      my $modify = undef;
      my $list = undef;
      my $read = undef;
      my $content = $thing->content;
      my $i;
      for ($i=0; $i<@$content; $i++) {
          my $sub = $content->[$i];
          if (ref $sub eq 'SMelt') {
             if ($sub->tagname eq 'add') {
                if (! defined $add) {
                    $add = $sub;
                } else {
		    &inform($thing,$indent+1,
                        "two definitions for add in converge!\n");
                    goto bad;
                }
             } elsif ($sub->tagname eq 'remove') {
                if (! defined $remove) {
                    $remove = $sub;
                } else {
		    &inform($thing,$indent+1,
                        "two definitions for remove in converge!\n");
                    goto bad;
                }
             } elsif ($sub->tagname eq 'modify') {
                if (! defined $modify) {
                    $modify = $sub;
                } else {
		    &inform($thing,$indent+1,
                        "two definitions for modify in converge!\n");
                    goto bad;
                }
             } elsif ($sub->tagname eq 'list') {
                if (! defined $list) {
                    $list = $sub;
                } else {
		    &inform($thing,$indent+1,
                        "two definitions for list in converge!\n");
                    goto bad;
                }
             } elsif ($sub->tagname eq 'read') {
                if (! defined $read) {
                    $read = $sub;
                } else {
		    &inform($thing,$indent+1,
                        "two definitions for read in converge!\n");
                    goto bad;
                }
             } else {
		&inform($thing,$indent+1,
                    "unknown tag ".$sub->tagname." in converge\n");
                goto bad;
             }
          }
      }
      if (! defined $add) {
        &inform($thing,$indent+1,"no definition for add in converge!\n");
        goto bad;
      }
      if (! defined $remove) {
        &inform($thing,$indent+1,"no definition for remove in converge!\n");
        goto bad;
      }
      if (! defined $modify) {
        &inform($thing,$indent+1,"no definition for modify in converge!\n");
        goto bad;
      }
      if (! defined $read) {
        &inform($thing,$indent+1,"no definition for read in converge!\n");
        goto bad;
      }
      if (! defined $list) {
        &inform($thing,$indent+1,"no definition for list in converge!\n");
        goto bad;
      }
      # now we have found a complete declaration list.
      # make a new scope and list instances into it.
      my $workscope = new SMscope(
          $scope, new SMfrstack((new SMframe({},'config','dynamic')))
      );

      # read a full record for each instance.
      my $ret = $whole->check_content($list->content,$workscope,$indent+1);
      if (! $ret) {
        &inform($thing,$indent+1,"checking listing of converge failed!\n");
        goto bad;
      }

      # compare new against old values.
      my $now = $workscope->val($inst);
      if (! defined $now) {
         &inform($thing,$indent+1,"no current instance info found!\n");
         goto bad;
      }
      if (ref $now ne "SMrestack") {
         &inform($thing,$indent+1,"running list isn't a repeat!\n");
         goto bad;
      }
      my $want = $scope->val($inst);
      if (! defined $want) {
         &inform($thing,$indent+1,"no desired instances defined for $inst!\n");
         goto bad;
      }
      if (ref $want ne "SMrestack") {
         &inform($thing,$indent+1,"declared list isn't a repeat!\n");
         goto bad;
      }
      if (! $want->iskey($key)) {
         &inform($thing,$indent,"key $key is not a unique key of the desired config!\n");
         goto bad;
      }
      # my @nowrange = sort $now->range($key);
      my @wantrange = sort $want->range($key);

      # add things that should exist
      # delete things that shouldn't exist
      # modify things that are different.
      my $wanti=0;
      for ($wanti=0; $wanti<@wantrange; $wanti++) { 

	  # grab subscope for this key from desired
	  my $wantinst = $want->instanceByKey($key,$wantrange[$wanti]);
	  if (! defined $wantinst) {
	     &inform($thing,$indent+1,"instance on $wantrange[$wanti] doesn't exist!\n")
;
	     goto bad;
	  }

	  # do an ersatz add
	  my $ret = $whole->check_content(
	      $add->content,
	      new SMscope($scope,$wantinst),
	      $indent+1);
	  if (!$ret) {
	      &inform($thing,$indent+1,"check of addition failed!\n");
	      goto bad;
	  }

	  # do an ersatz modify
	  my $ret = $whole->check_content(
	      $modify->content,
	      new SMscope($scope,$wantinst),
	      $indent+1);
	  if (!$ret) {
	      &inform($thing,$indent+1,"check of modify failed!\n");
	      goto bad;
	  }

	  # do an ersatz remove: should be on output of list, 
          # not input of modify!
	  my $ret = $whole->check_content(
	      $remove->content,
	      new SMscope($scope,$wantinst),
	      $indent+1);
	  if (!$ret) {
	      &inform($thing,$indent+1,"check of remove failed!\n");
	      goto bad;
	  }
      } 

   } elsif ($thing->tagname eq 'spawn') { # spawn a command stream
      my $command = $thing->attrs('command');   # command to run
      if (! defined $command) {
         &inform($thing,$indent+1,"no command for spawn!\n");
         goto bad;
      }
      my $ret = $whole->check_content(
         $thing->content,
         $scope,
         $indent+1);
      goto out; 

   } elsif ($thing->tagname eq 'bind') {
      my $file = $thing->attrs('file'); # command to run
      if (! defined $file) {
         &inform($thing,$indent+1,"no data file for bind!\n");
         goto bad;
      }
      my $config = newFile SMconfig($file);
      my $mod = $config->mod;
      my $workscope = new SMscope($scope,$mod);
      my $ret = $whole->check_content(
         $thing->content,
         $workscope,
         $indent+1);
      goto out; 

   } elsif ($thing->tagname eq 'dump') {
      my $file = $thing->attrs('file'); # command to run
      if (! defined $file) {
         &inform($thing,$indent+1,"no data file for dump!\n");
         goto bad;
      }
      goto good;

   } elsif ($thing->tagname eq 'timeout') {
      my $seconds = $thing->attrs('seconds');   # command to run
      if (! defined $seconds) {
         &inform($thing,$indent+1,"no seconds specified for timeout!\n");
         goto bad;
      }
      if ($seconds !~ /^[0-9]+$/) {
         &inform($thing,$indent+1,"$seconds is not a valid time!\n");
         goto bad;
      }
      goto good; 

   } else { 
      &inform($thing,$indent+1,"ignoring unknown tag '" . $thing->tagname . "'\n");
      # $whole->check($thing,$scope,$indent+1) ; 
   } 
out: 
   &main::debug(&spaces($indent). "end   check $thing->{'tagname'}\n",1); 
   return $ret; 
good:
   &main::debug(&spaces($indent). "end   check $thing->{'tagname'}\n",1); 
   return 1; 
bad: 
   &main::debug(&spaces($indent). "end   check $thing->{'tagname'}\n",1); 
   return undef; 
} 

# of course, doing something to content is doing it to each element. 
sub check_content { 
   my $whole = shift; 	# whole stream documentation. 
   my $content = shift; # current brook to invoke. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 
   my $thing; 
   foreach $thing (@$content) { 
      my $status = $whole->check($thing,$scope,$indent); 
      return undef if !$status; 
   }
   return 1; 
} 

#####
# conditionals are complex enough to require their own 
# handling. These three routines handle pattern mining, 
# binding, and ersatz execution, respectively. 
#####

# derive a pattern from content of an element by probing the first get tag. 
# return undef if tag inappropriate. 
sub check_cond_pattern { 
   my $whole = shift; 
   my $thing = shift;   # current brook to invoke. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 
   &main::debug(&DumpXML($thing,0,"check_cond_pattern> "),3); 
   if (ref $thing ne 'SMelt') { 
      &inform($thing,$indent+1,"branch pattern isn't valid"); 
      return undef; 
   } 
   my $content = $thing->content; 
   # this is naive; it's the first SMelt that I should be looking for. 
   my $i; 
   for ($i=0; $i<$#$content; $i++) { 
      last if ref $content->[$i] eq 'SMelt'; 
   } 
   if ($i == @$content) { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a tag"); 
      return undef;
   } 
   my $first = $content->[$i]; 
   if ($first->tagname ne 'get') { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a get"); 
      return undef; 
   } 
   return $first->getPattern($indent);
} 

# this routine binds variables in a given scope according to the 
# success of a get.  check bindings are fake and simply for flow analysis. 
# all strings in the binding are 'UNDEFINED' 
sub check_cond_bind { 
   my $whole = shift; 
   my $thing = shift;   # current brook to invoke. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 
   &main::debug(&DumpXML($thing,0,"check_cond_bind> "),3); 
   my $pat = $whole->check_cond_pattern($thing,$scope,$indent); 
   return undef if ! $pat; 
   my $res = &dummyGetPattern($thing,$pat); 
   # here any variables are bound. 
   my $key; my $value; 
   while (($key,$value) = each %$res) { 
      &main::debug(&spaces($indent)."junction: binding '$key' => '$value'\n"); 
   } 
   $scope->set($res); 
   return 1; 
} 

# check a conditional given that match was correct 
sub check_cond_content { 
   my $whole = shift; 
   my $thing = shift;   # current brook to invoke. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 
   &main::debug(&DumpXML($thing,0,"check_cond_content> "),3); 
   if (ref $thing ne 'SMelt') { 
      &inform($thing,$indent+1,"branch pattern isn't valid"); 
      return undef; 
   } 
   my $content = $thing->content; 
   # this is naive; it's the first SMelt that I should be looking for. 
   my $i; 
   for ($i=0; $i<$#$content; $i++) { 
      last if ref $content->[$i] eq 'SMelt'; 
   } 
   if ($i == @$content) { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a tag"); 
      return undef;
   } 
   my $first = $content->[$i]; 
   if ($first->tagname ne 'get') { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a get"); 
      return undef; 
   } 
   # found the content to execute; do it!
   my $cont = [ (@{$content})[$i+1..$#$content] ]; 
   return $whole->check_content($cont,$scope,$indent+1); 
} 

#####
# EXECUTION HANDLING SUBSYSTEM
# parallel to the type-checking subsystem, 
# actually do an execution by performing a walk through the 
# SMelt tree. Whereas a check tries all statements, this 
# implements conditionals and does true bindings
#####

####
# actually implement a stream, by performing the actions listed. 
# this is a matter of traversing the XML, reacting to branches and iterations, 
# and aborting on errors. This is parallel to the structure of 'check', 
# which tests without executing. The main difference is that 
# 'do' passes a stream as well as a scope stack in order to 
# facilitate direct interactions.  
#####

sub do { 
   my $whole = shift; 	# whole stream documentation. 
   my $thing = shift;   # current brook to invoke. 
   my $spawn = shift; 	# i/o stream to device. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 

   my $ret = 1; 

   $indent=0 if ! defined $indent; 

   if (ref $thing ne 'SMelt') { 
      if ($thing !~ /^[\s\n]*$/) { 
         &main::trace(&spaces($indent)
           . "unexpected literal \'$thing\' ignored in ssml\n",2); 
      } 
      return 1; 
   } 

   &trace($thing,$indent,"begin ". $thing->{'tagname'} . "\n",1); 
   &main::xmlout(&DumpXMLStart($thing,$indent,''),1); 

   if ($thing->tagname eq 'brook') { 
      $ret = $whole->do_content($thing->content,$spawn,$scope,$indent+1); 
      goto out; 

   } elsif ($thing->tagname eq 'get') { 
      my $pat = $thing->getPattern($indent); 
      &trace($thing,$indent+1,"get: want /$pat->[0]/\n",2); 
      my $ret = $spawn->get($pat->[0]); 
      if (! defined $ret->[2]) { 
	 &trace($thing,$indent+1,
             "get: got '".&SMelt::DumpString($ret->[0])."' (FAIL)\n",2); 
         goto bad; 
      } else { 
	 &trace($thing,$indent+1,
             "get: got '".&SMelt::DumpString($ret->[0])."' (OK)\n",2); 
         my $res = &applyGetPattern($ret->[0],$pat); 
	 # here any variables are bound. 
	 &trace($thing,$indent+1,"get bindings:\n",2); 
	 my $key; my $value; 
	 while (($key,$value) = each %$res) { 
	    &trace($thing,$indent+2,"get: binding '$key' => '$value'\n",2); 
            # &main::xmlout(&spaces($indent+2)."<var name='$key'>$value</var>\n",1);
 	 } 
         &main::xmlout(&spaces($indent+1)
	     .&documentGetPattern($ret->[0],$pat)."\n",1); 
         $scope->set($res); 
         goto good; 
      } 

   } elsif ($thing->tagname eq 'put') { 
      my $lit = $thing->putLiteral ($scope,$indent); 
      goto bad if ! defined $lit; 
      my $pat = $thing->putPattern ($scope,$indent); 
      goto bad if ! defined $pat; 
      my $xml = $thing->putXML($scope,$indent); 
# print STDERR "xml='$xml'\n"; 
      goto bad if ! defined $xml; 
      &main::xmlout(&spaces($indent+1). "$xml\n"); 
      &trace($thing,$indent+1,"put: put '" . &DumpString($lit) . "'\n",2); 
      &trace($thing,$indent+1,"put: get /" . $pat . "/\n",2); 
      my $ret = $spawn->put($lit,$pat); 
      if (! defined $ret->[2]) { 
	 &trace($thing,$indent+1,"put: got '" . &SMelt::DumpString($ret->[0]) 
	     . "' (FAIL)\n",2); 
         goto bad; 
      } else { 
	 &trace($thing,$indent+1,"put: got '" . &SMelt::DumpString($ret->[0]) 
	     . "' (OK)\n",2); 
         goto good; 
      } 

   } elsif ($thing->tagname eq 'case') { 
      # do instance cases, one per whole content of case tag
      my $iname = $thing->attrs('instance'); 
      if (defined $iname) { 
	 my $instance = $scope->val($iname); 
	 if (defined $instance) { 
	    my $status = $whole->do_content(
	       $thing->content,
	       $spawn,
	       (new SMscope($scope,$instance)), 
	       $indent+1) ; 
	    goto bad if !$status; 
	    goto good; 
	 } else {
	    &inform($thing,$indent+1,
                "required instance $iname not declared"
	        ." -- skipping case!\n"); 
	    goto good; 
	 }
      } else { 
	 &inform($thing,$indent+1,"no case namespace given"
	     ." -- skipping case!\n"); 
	 goto good; 
      } 

   } elsif ($thing->tagname eq 'repeat') { 
      # do instance repeats, one per whole content of repeat tag
      my $iname = $thing->attrs('instances'); 
      if (defined $iname) { 
	 my $instances = $scope->val($iname); 
	 if (defined $instances) { 
	    my $i; 
	    for ($i=0; $i<$instances->length; $i++) { 
	       my $status = $whole->do_content(
		  $thing->content,
		  $spawn,
		  (new SMscope($scope,$instances->instance($i))), 
		  $indent+1) ; 
	       goto bad if !$status; 
	    }
	    goto good; 
	 } else {
	    &inform($thing,$indent+1,"required instances $iname not declared"
	        ." -- skipping repeat!\n"); 
	    goto good; 
	 }
      } else { 
	 &inform($thing,$indent+1,"no repeat namespace declared"
	     ." -- skipping repeat!\n"); 
	 goto good; 
      } 

   } elsif ($thing->tagname eq 'while') { 
      # inductive discovery repeat
      my $iname = $thing->attrs('instances'); 
      if (defined $iname) { 
         my $content = $thing->content; 
         my $gnum; 
         for ($gnum=0; $gnum<@$content; $gnum++) { 
	    last if ref $content->[$gnum] eq 'SMelt'; 
         } 
	 my $guard = $content->[$gnum]; 
	 if ($gnum<@$content and defined $guard and ref $guard eq 'SMelt') { 
	    my @scopes = (); 
	    push(@scopes,
	       new SMscope($scope,
		   new SMfrstack(new SMframe({},'while','dynamic')))
	    ); 
	    while ($whole->do($guard,$spawn,$scopes[$#scopes],$indent+1)) { 
                my $i; 
		for ($i=$gnum+1; $i<@$content; $i++) { 
		   my $status = $whole->do(
		      $content->[$i],
		      $spawn,
		      $scopes[$#scopes],
		      $indent+1); 
		   last if ! $status; # break!
		} 
		# new scope for next time. 
		push(@scopes,
		   new SMscope($scope,
			new SMfrstack(new SMframe({},'instance','dynamic')))
		); 
	    } 
            pop (@scopes); 
            # now 'mine out' a repeat context and set a new
            # repeat variable in CURRENT scope
	    my $ins = []; 
            my $i; 
	    for ($i=0; $i<@scopes; $i++) { 
	        my $sco = $scopes[$i]; 
	        my $mod = $sco->[$#$sco]; 
		my $fra = $mod->[0]; 
# print STDERR "mod $i=\n"; 
# print STDERR Dumper($mod); 
# print STDERR "frame $i=\n"; 
# print STDERR Dumper($fra); 
                my $assoc = $fra->{'values'}; 
		if (scalar(keys %$assoc)!=0) {
		    &trace($thing,$indent+1,spaces($indent) . "while instance $i\n",2); 
		    my $key; my $value; 
		    while (($key,$value) = each %$assoc) { 
		       &trace($thing,$indent+1,spaces($indent) . " $key => $value\n",2); 
		    } 
		    my $newm = new SMfrstack (
		       (new SMframe($assoc,'instance','dynamic')),
		       (new SMframe({},'instance','dynamic'))
		    ); 
		    push (@$ins,$newm); 
		}
            } 
            my $rep = (new SMrestack(new SMrepeat ($ins,'static'))); 
   	    $scope->set({$iname => $rep}); 
	    goto good; 
	 } else { 
	    &inform($thing,$indent+1,"invalid guard tag in while -- skipping while!\n"); 
	    goto good; 
         } 
      } else { 
	 &inform($thing,$indent+1,"no while namespace given -- skipping while!\n"); 
	 goto good; 
      } 

   } elsif ($thing->tagname eq 'break') { 
      goto bad; 	# unconditional stop unless inside while loop

   } elsif ($thing->tagname eq 'perl') { 
      $ret = Sandbox::Control::eval($thing->content->[0],$scope,
          $thing->attrs('import'), $thing->attrs('export')); 
      goto out; 
   
   } elsif ($thing->tagname eq 'set') { 
      # set a variable in the current scope to a value. 

   } elsif ($thing->tagname eq 'test') { 
      # test a variable value for some condition

   } elsif ($thing->tagname eq 'insert') { 
      my $bname = $thing->attrs('brook'); 
      if (defined $bname) { 
	 my $brook = $whole->brook($bname); 
	 if (defined $brook) { 
	    my $iname = $thing->attrs('repeat'); 
	    if (defined $iname) { 
	       my $instances = $scope->val($iname); 
	       if (defined $instances) { 
		  my $i; 
		  for ($i=0; $i<@$instances; $i++) { 
		     my $status = $whole->do(
			$brook,
			$spawn,
		        (new SMscope($scope,$instances->[$i])),
		        $indent+1) ; 
		     goto bad if ! $status; 
		  }
	       } else {
		  &inform($thing,$indent+1,
		      "required instances $iname not declared"
		    . " -- skipping insert!\n"); 
	       }
	    } else { 
	       # no name binding given, just do it. 
	       $ret = $whole->do($brook,$spawn,$scope,$indent+1) ; 
               goto out; 
	    } 
	 } else { 
	    &inform($thing,$indent+1,"insert: no brook '$bname' -- skipping insert!\n"); 
	    goto good;
	 } 
      } else { 
	 &inform($thing,$indent+1,"insert: no brook name -- skipping insert!\n"); 
	 goto good; 
      }

   } elsif ($thing->tagname eq 'junction') { 
      my $content = $thing->content; 
      # first accumulate match patterns inside branches. 
      my $i; 
      my $branches = []; 
      for ($i=0; $i<@$content; $i++) { 
	my $branch = $content->[$i]; 
	if (ref $branch eq 'SMelt') {
	   if ($branch->tagname eq 'branch') { 
	      my $bc = $branch->content; 
	      if ($bc->[0]->tagname eq 'get') { 
		 push(@$branches,$branch); 
	      } else { 
		 &inform($thing,$indent+1,"ignoring branch whose first form isn't get!\n"); 
	      } 
	   } else { 
	      my $tag = $branch->tagname; 
	      &inform($thing,$indent+1,"non-branch '$tag' inside junction ignored!\n"); 
	   } 
	} else { 
	   &inform($thing,$indent+1,"non-tag data inside junction ignored!\n"); 
	} 
      } 
      # now create a get that'll select the appropriate branch: 
      my $patterns = []; 
      for ($i=0; $i<@$branches; $i++) { 
	my $bc = $branches->[$i]->content; 
	push(@$patterns,$bc->[0]->getPattern($indent)->[0]); 
      } 
      # and try to actually get it!
      for ($i=0; $i<@$patterns; $i++)  {
         &trace($thing,$indent+1,"junction: option /$patterns->[$i]/\n",2); 
      } 
      my $ret = $spawn->get(@$patterns); 
      if (defined $ret->[2]) { 
         &trace($thing,$indent+1,"junction: got '" 
                    . &SMelt::DumpString($ret->[0]) 
                    . "' (OK)\n",2); 

         my $offset = $ret->[2]; 
         my $branch = $branches->[$offset]; 

	 # first, bind variables from the get!
         $whole->do_cond_bind($branch,$spawn,$scope,$indent,$ret->[0]); 

	 # then do the rest of the cond!
         $ret = $whole->do_cond_content($branch,$spawn,$scope,$indent); 
         goto out; 

      } else { 
         &trace($thing,$indent+1,"junction: got '" 
	    . &SMelt::DumpString($ret->[0]) . "' (FAIL)\n",2); 
         my $i; 
 	 for ($i=0; $i<@$patterns; $i++) { 
 	    &trace($thing,$indent+1,
 	       " wanted /$patterns->[$i]/\n",2); 
 	 } 
         goto bad; 
      } 

   } elsif ($thing->tagname eq 'converge') { # convergent scripting
      # mine out various subsections of the convergent process
      my $key = $thing->attrs('key'); 		# name of key within instance
      if (! defined $key) { 
	 &inform($thing,$indent+1,"no key for converge!\n"); 
	 goto bad; 
      } 
      my $inst = $thing->attrs('instances'); 	# name of instance variable
      if (! defined $inst) { 
 	 &inform($thing,$indent+1,"no instances variable defined for converge!\n"); 
	 goto bad; 
      } 
      my $add = undef; 
      my $remove = undef; 
      my $modify = undef; 
      my $list = undef; 
      my $read = undef; 
      my $content = $thing->content; 
      my $i; 
      for ($i=0; $i<@$content; $i++) { 
          my $sub = $content->[$i]; 
	  if (ref $sub eq 'SMelt') { 
	     if ($sub->tagname eq 'add') { 
		if (! defined $add) { 
		    $add = $sub; 
		} else { 
		    &inform($thing,$indent+1,"two definitions for add in converge!\n"); 
		    goto bad; 
		} 
             } elsif ($sub->tagname eq 'remove') { 
		if (! defined $remove) { 
		    $remove = $sub; 
		} else { 
		    &inform($thing,$indent+1,"two definitions for remove in converge!\n"); 
		    goto bad; 
		} 
             } elsif ($sub->tagname eq 'modify') { 
		if (! defined $modify) { 
		    $modify = $sub; 
		} else { 
		    &inform($thing,$indent+1,"two definitions for modify in converge!\n"); 
		    goto bad; 
		} 
             } elsif ($sub->tagname eq 'list') { 
		if (! defined $list) { 
		    $list = $sub; 
		} else { 
		    &inform($thing,$indent+1,"two definitions for list in converge!\n"); 
		    goto bad; 
		} 
             } elsif ($sub->tagname eq 'read') { 
		if (! defined $read) { 
		    $read = $sub; 
		} else { 
		    &inform($thing,$indent+1,"two definitions for read in converge!\n"); 
		    goto bad; 
		} 
	     } else { 
		&inform($thing,$indent+1,"unknown tag ".$sub->tagname." in converge\n"); 
		goto bad; 
	     } 
          } 
      } 
      if (! defined $add) { 
	&inform($thing,$indent+1,"no definition for add in converge!\n"); 
	goto bad; 
      } 
      if (! defined $remove) { 
	&inform($thing,$indent+1,"no definition for remove in converge!\n"); 
	goto bad; 
      } 
      if (! defined $modify) { 
	&inform($thing,$indent+1,"no definition for modify in converge!\n"); 
	goto bad; 
      } 
      if (! defined $read) { 
	&inform($thing,$indent+1,"no definition for read in converge!\n"); 
	goto bad; 
      } 
      if (! defined $list) { 
	&inform($thing,$indent+1,"no definition for list in converge!\n"); 
	goto bad; 
      } 
      # now we have found a complete declaration list. 
      # make a new scope and list instances into it. 
      my $workscope = new SMscope(
	  $scope, new SMfrstack((new SMframe({},'config','dynamic')))
      ); 

      # read a full record for each instance. 
      my $ret = $whole->do_content($list->content,$spawn,$workscope,$indent+1); 
      if (! $ret) { 
	&inform($thing,$indent+1,"listing of converge failed!\n"); 
	goto bad; 
      } 

      # compare new against old values. 
      my $now = $workscope->val($inst); 
      if (! defined $now) { 
	 &inform($thing,$indent+1,"no current instance info found!\n");
	 goto bad; 
      } 
      if (ref $now ne "SMrestack") { 
	 &inform($thing,$indent+1,"running list isn't a repeat!\n");
	 goto bad; 
      } 
      my $want = $scope->val($inst); 
      if (! defined $want) { 
	 &inform($thing,$indent+1,"no desired instances defined for $inst!\n");
	 goto bad; 
      } 
      if (ref $want ne "SMrestack") { 
	 &inform($thing,$indent+1,"declared list isn't a repeat!\n");
	 goto bad; 
      } 
      if (! $now->iskey($key)) { 
	 &inform($thing,$indent+1,"key $key is not a unique key of the running config!\n");
	 goto bad; 
      } 
      if (! $want->iskey($key)) { 
	 &inform($thing,$indent+1,"key $key is not a unique key of the desired config!\n");
	 goto bad; 
      } 
      my @nowrange = sort $now->range($key); 
      my @wantrange = sort $want->range($key); 

      # add things that should exist
      # delete things that shouldn't exist
      # modify things that are different. 
      my $nowi =0; 
      my $wanti=0; 
      while ($nowi<@nowrange or $wanti<@wantrange) { 
	 if ($nowi>=@nowrange) { # want extra stuff
	     # something missing: add $wantrange[$wanti]
	     &trace($thing,$indent+1,"creating missing instance $wantrange[$wanti]\n",2); 

	     # grab subscope for this key from desired
	     my $wantinst = $want->instanceByKey($key,$wantrange[$wanti]); 
	     if (! defined $wantinst) { 
		&inform($thing,$indent+1,"instance on $wantrange[$wanti] doesn't exist!\n"); 
		goto bad; 
	     } 

	     # do the add
	     my $ret = $whole->do_content(
		 $add->content, 
                 $spawn,
		 new SMscope($scope,$wantinst), 
		 $indent+1); 
	     if (!$ret) { 
		 &inform($thing,$indent+1,"addition failed!\n"); 
		 goto bad; 
	     } 

### 	     # now see if changes worked!
###              # this doesn't work as nowinst isn't defined yet. Must create. 
### 
### 	     # grab subscope for this key from working scope
### 	     my $nowinst = $now->instanceByKey($key,$nowrange[$nowi]); 
### 	     if (! defined $nowinst) { 
### 		&inform($thing,$indent+1,"current $nowrange[$nowi] doesn't exist!\n"); 
### 		goto bad; 
### 	     } 
### 	     $ret = $whole->do_content(
### 		 $read->content, 
### 		 $spawn,
### 		 new SMscope($scope,$nowinst), 
### 		 $indent+1); 
### 	     # compare data in working and desired scopes. 
### 	     # first get a list of keys from the working scope
### 	     my @nowkeys = $nowinst->keys; 
### 	     # then compare values for each of these keys
### 	     my $diff = 0; 
### 	     my $i; 
### 	     for ($i=0; $i<@nowkeys; $i++) { 
### 		 my $w = $wantinst->val($nowkeys[$i]); 
### 		 my $n = $nowinst->val($nowkeys[$i]); 
### 		 if (defined $w and $w ne $n) { 
### 		     $diff++; 
### 		     &inform($thing,$indent+1,"$nowkeys[$i]: still want '$w', have '$n'!\n"); 
### 		 } 
### 	     } 
### 	     if ($diff) { 
### 		 &inform($thing,$indent+1,"modify attempt seemed to work but failed!\n"); 
### 		 goto bad; 
### 	     } 
	     $wanti++; 
         } elsif ($wanti>=@wantrange) {  # delete extraneous stuff
	     # something extra: delete $nowrange[$nowi]
	     &trace($thing,$indent+1,"deleting extra instance $nowrange[$nowi]\n",2); 
	     # grab subscope for this key from working scope
	     my $nowinst = $now->instanceByKey($key,$nowrange[$nowi]); 
	     if (! defined $nowinst) { 
		&inform($thing,$indent+1,"current $nowrange[$nowi] doesn't exist!\n"); 
		goto bad; 
	     } 

	     # do the removal
	     my $ret = $whole->do_content(
		 $remove->content, 
		 $spawn, 
		 new SMscope($scope,$nowinst), 
		 $indent+1); 
	     if (!$ret) { 
		 &inform($thing,$indent+1,"removal failed!\n"); 
		 goto bad; 
	     } 
	     # see if changes worked by relisting!
	     $nowi++
         } else { # both in range
	     if ($nowrange[$nowi] lt $wantrange[$wanti]) { 
	        # something extra: delete $nowrange[$nowi]
	        &trace($thing,$indent+1,"deleting extra instance $nowrange[$nowi]\n",2); 

		# grab subscope for this key from working scope
                my $nowinst = $now->instanceByKey($key,$nowrange[$nowi]); 
		if (! defined $nowinst) { 
		   &inform($thing,$indent+1,"current $nowrange[$nowi] doesn't exist!\n"); 
		   goto bad; 
	        } 

		# now do the removal
		my $ret = $whole->do_content(
		    $remove->content, 
		    $spawn,
		    new SMscope($scope,$nowinst), 
		    $indent+1); 
		if (!$ret) { 
		    &inform($thing,$indent+1,"removal failed!\n"); 
		    goto bad; 
		} 
		$nowi++; 
	     } elsif ($nowrange[$nowi] gt $wantrange[$wanti]) { 
	        # something missing: add $wantrange[$wanti]
	        &trace($thing,$indent+1,"creating missing instance $wantrange[$wanti]\n",2); 
		# grab subscope for this key from desired
                my $wantinst = $want->instanceByKey($key,$wantrange[$wanti]); 
		if (! defined $wantinst) { 
		   &inform($thing,$indent+1,"instance on $wantrange[$wanti] doesn't exist!\n"); 
		   goto bad; 
	        } 
		my $ret = $whole->do_content(
		    $add->content, 
		    $spawn, 
		    new SMscope($scope,$wantinst), 
		    $indent+1); 
		if (!$ret) { 
		    &inform($thing,$indent+1,"addition failed!\n"); 
		    goto bad; 
		} 
                $wanti++; 
	     } else { # $nowrange[$nowi] eq $wantrange[$wanti]

	        # matching record: modify things if necessary
		&trace($thing,$indent+1,"comparing data for $nowrange[$nowi]\n",2); 

		# grab subscope for this key from working scope
                my $nowinst = $now->instanceByKey($key,$nowrange[$nowi]); 
		if (! defined $nowinst) { 
		   &inform($thing,$indent+1,"current $nowrange[$nowi] doesn't exist!\n"); 
		   goto bad; 
	        } 

		# grab wanted instance from documentation 
                my $wantinst = $want->instanceByKey($key,$wantrange[$wanti]); 
		if (! defined $wantinst) { 
		   &inform($thing,$indent+1,"wanted $wantrange[$wanti] doesn't exist!\n"); 
		   goto bad; 
	        } 

	        # create new scope with subscope in front. 
	        # call read request in this scope. 
		my $ret = $whole->do_content(
		    $read->content, 
		    $spawn, 
		    new SMscope($scope,$nowinst), 
		    $indent+1); 
		# compare data in working and desired scopes. 
		# first get a list of keys from the working scope
                my @nowkeys = $nowinst->keys; 
                # then compare values for each of these keys
	        my $diff = 0; 
                my $i; 
                for ($i=0; $i<@nowkeys; $i++) { 
		    my $w = $wantinst->val($nowkeys[$i]); # from original decl
		    my $n = $nowinst->val($nowkeys[$i]); # from current val
                    if (defined $w and $w ne $n) { 
			$diff++; 
			&trace($thing,$indent+1,"$nowkeys[$i]: want '$w', have '$n'!\n",3); 
		    } 
                } 
		if ($diff) { 
		    my $ret = $whole->do_content(
		        $modify->content, 
			$spawn,
			new SMscope($scope,$wantinst), 
			$indent+1); 
		    if (! $ret) { 
			&inform($thing,$indent+1,"modify failed!\n"); 
			goto bad; 
		    } 
		    # now see if changes worked!
		    $ret = $whole->do_content(
			$read->content, 
			$spawn,
			new SMscope($scope,$nowinst), 
			$indent+1); 
		    # compare data in working and desired scopes. 
		    # first get a list of keys from the working scope
		    my @nowkeys = $nowinst->keys; 
		    # then compare values for each of these keys
		    my $diff = 0; 
		    my $i; 
		    for ($i=0; $i<@nowkeys; $i++) { 
			my $w = $wantinst->val($nowkeys[$i]); 
			my $n = $nowinst->val($nowkeys[$i]); 
			if (defined $w and $w ne $n) { 
			    $diff++; 
			    &inform($thing,$indent+1,"$nowkeys[$i]: still want '$w', have '$n'!\n"); 
			} 
		    } 
		    if ($diff) { 
			&inform($thing,$indent+1,"modify attempt seemed to work but failed!\n"); 
			goto bad; 
		    } 
		} else { 
		    &trace($thing,$indent+1,"no modification required!\n",2); 
		} 
		
                $nowi++; $wanti++;
	     } 
         } 
      } 
   
###
# binding control: bind streams or variable declarations
### 

   } elsif ($thing->tagname eq 'spawn') { # spawn a command stream
      my $command = $thing->attrs('command');	# command to run
      if (! defined $command) { 
	 &inform($thing,$indent+1,"no command for spawn!\n"); 
	 goto bad; 
      } 
      my $workspawn = new Spawn($command); 	# invoke a command
      my $ret = $whole->do_content(
	 $thing->content,
	 $workspawn,
	 $scope,
	 $indent+1); 
      $workspawn->close; 			# blow it away
      goto out; 

   } elsif ($thing->tagname eq 'bind') { 
      my $file = $thing->attrs('file');	# command to run
      if (! defined $file) { 
	 &inform($thing,$indent+1,"no data file for bind!\n"); 
	 goto bad; 
      } 
      my $config = newFile SMconfig($file);
      my $mod = $config->mod;
      my $workscope = new SMscope($scope,$mod);
      my $ret = $whole->do_content(
	 $thing->content,
	 $spawn,
	 $workscope,
	 $indent+1); 
      goto out; 

   } elsif ($thing->tagname eq 'dump') { 
      my $file = $thing->attrs('file');	# command to run
      if (! defined $file) { 
	 &inform($thing,$indent+1,"no data file for dump!\n"); 
	 goto bad; 
      } 
      if (!open(FILE,">$file")) { 
	 &inform($thing,$indent+1,"cannot write dumpfile $file!\n"); 
         goto bad; 
      } 
      my $out = $scope->dump; 
      print FILE $out; 
      close FILE; 
      goto good; 

###
# parameter control: control how interpreter works
###

   } elsif ($thing->tagname eq 'timeout') { 
      my $seconds = $thing->attrs('seconds');	# command to run
      if (! defined $seconds) { 
	 &inform($thing,$indent+1,"no seconds specified for timeout!\n"); 
	 goto bad; 
      } 
      if ($seconds !~ /^[0-9]+$/) { 
	 &inform($thing,$indent+1,"$seconds is not a valid time!\n"); 
	 goto bad; 
      } 
      if (! defined $spawn) { 
         &inform($thing,$indent+1,"no spawn to apply timeout to!\n"); 
         goto bad; 
      } 
      $spawn->{'timeout'}=$seconds; # make it stick

   } else { 
      &trace($thing,$indent+1,"ignoring unknown tag '" . $thing->tagname . "'\n"); 
   } 
   goto good; 
out: 
   &trace($thing,$indent,"end   $thing->{'tagname'}\n",1); 
   &main::xmlout(&DumpXMLEnd($thing,$indent,'')); 
   return $ret; 
good:
   &trace($thing,$indent,"end   $thing->{'tagname'}\n",1); 
   &main::xmlout(&DumpXMLEnd($thing,$indent,'')); 
   return 1; 
bad: 
   &trace($thing,$indent,"end   $thing->{'tagname'}\n",1); 
   &main::xmlout(&DumpXMLEnd($thing,$indent,'')); 
   return undef; 
} 

# of course, doing something to content is doing it to each element. 
sub do_content { 
   my $whole = shift; 	# whole stream documentation. 
   my $content = shift; # current brook to invoke. 
   my $spawn = shift; 	# i/o stream to device. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 
   my $thing; 
   foreach $thing (@$content) { 
      my $status = $whole->do($thing,$spawn,$scope,$indent); 
      return undef if !$status; 
   }
   return 1; 
} 

#####
# conditionals are complex enough to require their own private handling
# these routines handle pattern mining, binding, and conditional 
# execution for all kinds. 
#####

# derive a pattern from content of an element by probing the first get tag. 
# return undef if tag inappropriate. 
sub do_cond_pattern { 
   my $whole = shift; 
   my $thing = shift;   # current brook to invoke. 
   my $spawn = shift; 	# i/o stream to device. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 
   &main::trace(&DumpXML($thing,0,"do_cond_pattern> "),3); 
   if (ref $thing ne 'SMelt') { 
      &inform($thing,$indent+1,"branch pattern isn't valid"); 
      return undef; 
   } 
   my $content = $thing->content; 
   # this is naive; it's the first SMelt that I should be looking for. 
   my $i; 
   for ($i=0; $i<$#$content; $i++) { 
      last if ref $content->[$i] eq 'SMelt'; 
   } 
   if ($i == @$content) { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a tag"); 
      return undef;
   } 
   my $first = $content->[$i]; 
   if ($first->tagname ne 'get') { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a get"); 
      return undef; 
   } 
   return $first->getPattern($indent);
} 

# do a conditional given that match was correct 
sub do_cond_content { 
   my $whole = shift; 
   my $thing = shift;   # current brook to invoke. 
   my $spawn = shift; 	# i/o stream to device. 
   my $scope = shift; 	# name scope for variables. 
   my $indent = shift; 
   &main::trace(&DumpXML($thing,0,"do_cond_content> "),3); 
   if (ref $thing ne 'SMelt') { 
      &inform($thing,$indent+1,"branch pattern isn't valid"); 
      return undef; 
   } 
   my $content = $thing->content; 
   # this is naive; it's the first SMelt that I should be looking for. 
   my $i; 
   for ($i=0; $i<$#$content; $i++) { 
      last if ref $content->[$i] eq 'SMelt'; 
   } 
   if ($i == @$content) { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a tag"); 
      return undef;
   } 
   my $first = $content->[$i]; 
   if ($first->tagname ne 'get') { 
      &inform($thing,$indent+1,"branch pattern doesn't start with a get"); 
      return undef; 
   } 
   # found the content to execute; do it!
   my $cont = [ (@{$content})[$i+1..$#$content] ]; 
   return $whole->do_content($cont,$spawn,$scope,$indent+1); 
} 

# this routine binds variables in a given scope according to the 
# success of a get. 
sub do_cond_bind { 
   my $whole  = shift; 
   my $thing  = shift;  # current brook to invoke. 
   my $spawn  = shift; 	# i/o stream to device. 
   my $scope  = shift; 	# name scope for variables. 
   my $indent = shift; 
   my $text   = shift; 	# text to match in order to bind. 
   &trace($thing,$indent+1,"cond_bind: got '".&SMelt::DumpString($text)."' (OK)\n",2); 
   &main::trace(&DumpXML($thing,0,"do_cond_bind> "),3); 
   my $pat = $whole->do_cond_pattern($thing,$spawn,$scope,$indent); 
   my $res = &applyGetPattern($text,$pat); 
   # here any variables are bound. 
   my $key; my $value; 
   while (($key,$value) = each %$res) { 
      &trace($thing,$indent+1,"cond_bind: binding '$key' => '$value'\n",2); 
   } 
   $scope->set($res); 
   return 1; 
} 

#####
# for debugging, dump a pretty-printed XML representation of the current tree. 
#####

sub DumpXML {
   my $ssml = shift; 
   my $indent = shift; $indent=0 if ! defined $indent; 
   my $prefix = shift; $prefix = '' if ! defined $prefix; 
   my $out = ""; 

   $out .= &DumpXMLStart($ssml,$indent,$prefix); 
   $out .= &DumpXMLContent($ssml,$indent+1,$prefix); 
   $out .= &DumpXMLEnd($ssml,$indent,$prefix); 
   return $out; 
} 

sub DumpXMLStart { 
   my $ssml = shift; 
   my $indent = shift; $indent=0 if ! defined $indent; 
   my $prefix = shift; $prefix = '' if ! defined $prefix; 
   my $out = ""; 

   # handle text specially
   if (ref $ssml ne 'SMelt') { 
      $out .= $prefix . &spaces($indent); 
      $out .= $ssml; 
      $out .= "\n"; 
      return $out; 
   } 

   # put in current tag
   $out .= $prefix . &spaces($indent); 
   $out .= "<" . $ssml->{'tagname'};
   my $key; my $value; 
   while (($key,$value) = each %{$ssml->attrs}) { 
      $out .= " $key=\"". $value. "\""; 
   } 
   $out .= ">\n"; 
   return $out; 
} 

sub DumpXMLContent { 
   my $ssml = shift; 
   my $indent = shift; $indent=0 if ! defined $indent; 
   my $prefix = shift; $prefix = '' if ! defined $prefix; 
   my $out = ""; 
   if (ref $ssml eq 'SMelt') { 
      my $thing; foreach $thing (@{$ssml->{'content'}}) { 
         $out .= &DumpXML($thing,$indent,$prefix); 
      } 
   } 
   return $out; 
} 

sub DumpXMLEnd { 
   my $ssml = shift; 
   my $indent = shift; $indent=0 if ! defined $indent; 
   my $prefix = shift; $prefix = '' if ! defined $prefix; 
   my $out = ""; 
   if (ref $ssml eq 'SMelt') { 
      $out .= $prefix . &spaces($indent); 
      $out .= "</" . $ssml->{'tagname'} . ">\n"; 
   } 
   return $out; 
} 

#####
# dump a string with controls visible for debugging. 
#####

sub DumpString { 
   my $string = shift; 
   my $i; 
   my $out; 
   for ($i=0; $i<length($string); $i++) { 
       my $c = substr($string,$i,1); 
       if ($c eq '&') { 
           $out .= '&amp;'; 
       } elsif ($c eq '<') { 
           $out .= '&lt;'; 
       } elsif ($c eq '>') { 
           $out .= '&gt;'; 
       } elsif ($c eq '"') { 
           $out .= '&quot;'; 
       } elsif ($c eq ' ') { 
           $out .= '\s'; 
       } elsif (ord($c) >= 0x20) { 
	   $out .= $c; 
       } elsif ( $c eq "\n") { 
	   $out .= '\n' . "\n"; 
       } elsif ( $c eq "\r") { 
	   $out .= '\r'; 
       } elsif ( $c eq "\b") { 
	   $out .= '\b'; 
       } elsif ( $c eq "\t") { 
	   $out .= '\t'; 
       } elsif ( $c eq "\f") { 
	   $out .= '\f'; 
       } else { 
	   $out .= sprintf("{%03o}",ord($c)); 
       } 
   } 
   return $out; 
} 


#####
# pattern matching subsystem
# these cooperative routines handle pattern mining, matching, 
# binding, and testing. 
#####

#####
# this mines a pattern out of XML, escaping non-pattern text as needed. 
# return value is a pair of items: 
# a) the pattern
# b) the variables bound to positions. 
#####

sub getPattern { 
   my $self = shift; 
   my $indent = shift; 
   if ($self->tagname eq 'get') { 
      my $pattern = &getPattern_aux($self->content,$indent); 
      return $pattern; 
   } else { 
      die "patterns can only be extracted from <get> elements!"; 
   }
} 

#####
# auxiliary pattern matching runtine does an easy template match. 
# march through the XML generating patterns. 
#####

sub getPattern_aux { 
   my $content = shift; 
   my $indent = shift; 
   my $count = 1; 
   my $pat = ["",[],"",[]]; 
   my $i; for ($i=0; $i<@$content; $i++) {
      my $thing = $content->[$i]; 
      if (ref $thing ne "SMelt") { 
         $pat->[0] .= &escapeLiteral($thing); 
         $pat->[2] .= '('.&escapeLiteral($thing).')'; 
         push(@{$pat->[3]}, $thing);
      } elsif ($thing->tagname eq 'var') { 
         if (defined $thing->attrs->{'pattern'} ) { 
	    $pat->[0] .= "(" 
                      .  &escapePattern($content->[$i]->attrs->{'pattern'}) 
                      .  ")"; 
            push(@{$pat->[1]},$content->[$i]->attrs->{'name'}); 
	    $pat->[2] .= "(" 
                      .  &escapePattern($content->[$i]->attrs->{'pattern'}) 
                      .  ")"; 
            push(@{$pat->[3]}, $thing);
	 } else { 
	    &inform($thing,$indent+1,"no pattern for var \'" 
		. $content->[$i]->attrs->{'name'} . "\'!\n");  
	    $pat->[0] .= "()"; 
            push(@{$pat->[1]},$content->[$i]->attrs->{'name'}); 
	    $pat->[2] .= "(" 
                      .  &escapePattern($content->[$i]->attrs->{'pattern'}) 
                      .  ")"; 
            push(@{$pat->[3]}, $thing);

         } 
      } elsif ($thing->tagname eq 'char') { 
	 $pat->[0] .=  chr($thing->attrs->{'code'}); 
	 $pat->[2] .=  chr($thing->attrs->{'code'}); 
	 $pat->[3] .=  chr($thing->attrs->{'code'}); 
      } elsif ($thing->tagname eq 'whitespace') { 
	 $pat->[0] .= '\s+'; 
	 $pat->[2] .= '\s+'; 
	 $pat->[3] .= ' '; 
      } else { # default is to barf and complain
	 &inform($thing,$indent+1,"unknown tag name ".$thing->tagname." in getPattern!\n"); 
         # $lit .= "<<unknown tag ".$thing->tagname . ">>>"; 
         # $pat = undef; 
      } 
   } 
   return $pat; 
} 

#####
# this applies a get pattern returned by getPattern to a particular
# block of input. It returns either the bound assoc array or 
# undef if there's no match.  This is a kludge with only 16 
# possible matches. This should be fixed. 
#####

sub applyGetPattern { 
   my $stream = shift; 
   my $bindings = shift; 
   my $pattern = $bindings->[0]; 
   my $vars = $bindings->[1]; 
   if ($stream =~ /$pattern/) { 
      my $assoc = {}; 
      my @stuff = ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12,$13,$14,$15,$16); 
      my $i; for ($i=0; $i<@$vars; $i++) { 
          $assoc->{$vars->[$i]} = $stuff[$i]
	     if defined $vars->[$i]; 
      } 
      return $assoc; 
   } else { 
      return undef; 
   } 
} 

#####
# for checking, return dummy pattern of bindings
# must remember not to further validate these matches!
#####

sub dummyGetPattern { 
   my $stream = shift; 
   my $bindings = shift; 
   my $pattern = $bindings->[0]; 
   my $vars = $bindings->[1]; 
   my $assoc = {}; 
   my $i; for ($i=0; $i<@$vars; $i++) { 
       $assoc->{$vars->[$i]} = 'UNKNOWN'
	  if defined $vars->[$i]; 
   } 
   return $assoc; 
} 

#####
# this routine generates XML that documents what a getPattern did. 
#####
sub documentGetPattern { 
   my $stream = shift; 
   my $bindings = shift; 
   my $pattern = $bindings->[2]; 
   my $vars = $bindings->[3]; 
# print STDERR "input  stream=$stream\n"; 
# print STDERR "pattern=$pattern\n"; 
   my $ret; 
   if ($stream =~ m/$pattern/) { 
      my $matches = []; 
      my $i; 
      for ($i=0; $i<@$vars; $i++) { 
         push(@$matches, eval ('$' . ($i+1))); 
      } 
      my $out = ''; 
      for ($i=0; $i<@$vars; $i++) { 
         my $thing = $vars->[$i]; 
         if (ref $thing ne 'SMelt') { 
            $out .= &SMelt::DumpString($matches->[$i]); 
         } else { 
            $out .= '<var'; 
            $out .= " name='" . $thing->attrs->{'name'} . "'"
 		if defined $thing->attrs->{'name'}; 
            $out .= " pattern='" . $thing->attrs->{'pattern'} . "'"
 		if defined $thing->attrs->{'pattern'}; 
            $out .= '>'; 
            $out .= &SMelt::DumpString($matches->[$i]); 
            $out .= '</var>'; 
         } 
      } 
      return $out; 
   } else { 
      return undef; 
   } 
} 

#####
# put subsystem handles direct interaction with devices. 
#####

#####
# extract a literal thing to put into the output stream
# this is the thing with control characters literal. 
#####
sub putLiteral { 
   my $self = shift; 
   my $bindings = shift; 
   my $indent = shift; 
   if ($self->tagname eq 'put') { 
      my $lit = &putLiteral_aux($self->content, $bindings, $indent); 
      return $lit; 
   } else { 
      die "putLiterals can only be extracted from <put> elements!"; 
   }
} 

#####
# handle recursive subcases of putLiteral
#####
sub putLiteral_aux { 
   my $content = shift; 
   my $bindings = shift; 
   my $indent = shift; 
   my $i; 
   my $lit = ""; 
   for ($i=0; $i<@$content; $i++) {
      my $thing = $content->[$i]; 
      if (ref $thing ne "SMelt") { 
         $lit .= $thing; 
      } elsif ($thing->tagname eq 'var') { 
         my $name = $thing->attrs->{'name'}; 
         if (defined $name) { 
            my $val = $bindings->val($name); 
            if (! defined $val) { 
		&inform($thing,$indent+1,"no binding for required var '" . $name . "'\n"); 
		return undef; 
            } elsif (ref $val ne '') { 
                &inform($thing,$indent+1,"value of var $name isn't a string!\n"); 
	        return undef; 
            } else { 
	        $lit .= $val; 
            } 
	 } else { 
	    &inform($thing,$indent+1,"no name specified for put var!\n"); 
	    # $lit .= "<<<unknown>>>"; 
	    return undef; 
         } 
      } elsif ($thing->tagname eq 'noecho') { 
	 # doesn't show up on return echo
         $lit .= &putLiteral_aux($thing->content,$bindings); 
      } elsif ($thing->tagname eq 'stars') { 
         $lit .= &putLiteral_aux($thing->content,$bindings); 
      } elsif ($thing->tagname eq 'whitespace') { 
	 $lit .= ' '; 
      } else { # default is to barf and complain
	 &inform($thing,$indent+1,"unknown tag name ".
		$thing->tagname." in putLiteral!\n"); 
         # $lit .= "<<<unknown tag ".$thing->tagname . ">>>"; 
	 return undef; 
      } 
   } 
   return $lit; 
} 

#####
# extract a pattern matching a literal thing to put
# this thing has control characters converted and visible. 
#####

sub putPattern { 
   my $self = shift; 
   my $bindings = shift; 
   my $indent = shift; 
   if ($self->tagname eq 'put') { 
      my $pattern = &putPattern_aux($self->content, $bindings, $indent); 
      return $pattern; 
   } else { 
      die "put patterns can only be extracted from <put> elements!"; 
   }
} 

#####
# helper for recursive traversal needed in putPattern. 
#####

sub putPattern_aux { 
   my $content = shift; 
   my $bindings = shift; 
   my $indent = shift; 
   my $i; 
   my $pat = ""; 
   for ($i=0; $i<@$content; $i++) {
      my $thing = $content->[$i]; 
      if (ref $thing ne "SMelt") { 
         $pat .= &escapeLiteral($thing); 
      } elsif ($thing->tagname eq 'var') { 
         my $name = $thing->attrs->{'name'}; 
         if (defined $name) { 
            my $val = $bindings->val($name); 
            if (! defined $val) { 
		&inform($thing,$indent+1,"no binding for required var '" . $name . "'\n"); 
		return undef; 
            } elsif (ref $val ne '') { 
                &inform($thing,$indent+1,"value of var $name isn't a string!\n"); 
	        return undef; 
            } else { 
	        $pat .= &escapeLiteral($val) ; 
            } 
	 } else { 
	    &inform($thing,$indent+1,"no name specified for put var!\n"); 
	    # $pat .= "<<<no name>>>"; 
	    return undef; 
         } 
      } elsif ($thing->tagname eq 'noecho') { 
	 # doesn't show up
      } elsif ($thing->tagname eq 'stars') { 
	 # this computation should be checked carefully
         my $out = &putPattern_aux($thing->content,$bindings); 
         $pat .= &escapeLiteral(&stars(length($out))); 
      } elsif ($thing->tagname eq 'whitespace') { 
	 $pat .= '\s+'; 
      } else { # default is to barf and complain
	 &inform($thing,$indent+1,"unknown tag name ".$thing->tagname." in putPattern!\n");
         # $pat .= "<<<unknown tag ".$thing->tagname . ">>>"; 
         return undef; 
      } 
   } 
   return $pat; 
} 

#####
# extract a pattern matching a literal thing to put
# this thing has control characters converted and visible. 
#####

sub putXML { 
   my $self = shift; 
   my $bindings = shift; 
   my $indent = shift; 
   if ($self->tagname eq 'put') { 
      my $pattern = &putXML_aux($self->content, $bindings,$indent); 
      return $pattern; 
   } else { 
      die "put patterns can only be extracted from <put> elements!"; 
   }
} 

#####
# helper for recursive traversal needed in putXML. 
#####

sub putXML_aux { 
   my $content = shift; 
   my $bindings = shift; 
   my $indent = shift; 
   my $i; 
   my $pat = ""; 
   for ($i=0; $i<@$content; $i++) {
      my $thing = $content->[$i]; 
      if (ref $thing ne "SMelt") { 
         $pat .= &escapeLiteral($thing); 
      } elsif ($thing->tagname eq 'var') { 
         my $name = $thing->attrs->{'name'}; 
         if (defined $name) { 
            my $val = $bindings->val($name); 
            if (! defined $val) { 
		&inform($thing,$indent+1,"no binding for required var '" . $name . "'\n"); 
		return undef; 
            } elsif (ref $val ne '') { 
                &inform($thing,$indent+1,"value of var $name isn't a string!\n"); 
	        return undef; 
            } else { 
	        $pat .= "<var name='$name'>" . &escapeLiteral($val) . "</var>" ;
            } 
	 } else { 
	    &inform($thing,$indent+1,"no name specified for put var!\n"); 
	    # $pat .= "<<<no name>>>"; 
	    return undef; 
         } 
      } elsif ($thing->tagname eq 'noecho') { 
	 # doesn't show up
         my $out = &putXML_aux($thing->content,$bindings); 
         $pat .= "<noecho>" . $out . "</noecho>"; 
      } elsif ($thing->tagname eq 'stars') { 
         my $out = &putXML_aux($thing->content,$bindings); 
         $pat .= "<stars>" . $out . "</stars>"; 
      } elsif ($thing->tagname eq 'whitespace') { 
	 $pat .= "<whitespace/>"; 
      } else { # default is to barf and complain
	 &inform($thing,$indent+1,"unknown tag name ".$thing->tagname." in putXML!\n");
         return undef; 
      } 
   } 
   return $pat; 
} 

#####
# utility routines 
#####

# make a group of spaces to indent output
sub spaces { 
   my $no = shift; 
   my $out = ''; 
   my $i; 
   for ($i=0; $i<$no; $i++) { $out .= ' '; } 
   return $out; 
} 

# make a group of stars for output
sub stars { 
   my $no = shift; 
   my $out = ''; 
   my $i; 
   for ($i=0; $i<$no; $i++) { $out .= '*'; } 
   return $out; 
} 

# translate a literal string so it can appear in a pattern
# without invoking magic pattern properties. 
sub escapeLiteral { 
   my $string = shift; 
   $string =~ s/\r/\\r/g; 	# translate literal \r, \n, \t to their codes
   $string =~ s/\n/\\n/g; 	
   $string =~ s/\t/\\t/g; 
   $string =~ s/\f/\\f/g; 
   $string =~ s/\//\\\//g; 	# escape closing /
   $string =~ s/\./\\\./g; 	# escape magic pattern characters into literals
   $string =~ s/\*/\\\*/g; 
   $string =~ s/\+/\\\+/g; 
   $string =~ s/\?/\\\?/g; 
   $string =~ s/\|/\\\|/g; 
   $string =~ s/\[/\\\[/g; 
   $string =~ s/\]/\\\]/g; 
   $string =~ s/\{/\\\{/g; 
   $string =~ s/\}/\\\}/g; 
   $string =~ s/\(/\\\(/g; 
   $string =~ s/\)/\\\)/g; 
   $string =~ s/\^/\\\^/g; 
   $string =~ s/\$/\\\$/g; 
   # translate any embedded control characters to their 
   # pattern equivalents
   my $len = length($string); 
   my $i; for ($i=0; $i<$len; $i++) { 
      my $ch = substr($string,$i,1); 
      if (ord($ch)<32) { 
         substr($string,$i,1)=sprintf("\\%03o",ord($ch)); 
      } 
   } 
   return $string; 
} 

#####
# escape a Babble pattern so it can appear in a Perl pattern
# match, by removing () magic and escaping /. 
#####

sub escapePattern { 
   my $string = shift; 
   $string =~ s/\(/\\\(/g; # disable magic parens so won't confuse matcher
   $string =~ s/\)/\\\)/g; 
   $string =~ s/\//\\\//g; # escape closing /
   return $string; 
} 

#####
# these (private) routines comprise part of the parser
# and react to opening, closing, and text parsing events. 
#####

sub handle_start { 
   my $expat = shift; 
   my $tagname = shift; 
   my %attrs = @_; 
   &main::debug("begin handle_start '$tagname' (line "
        . $expat->current_line . ")\n",3); 
   my $entry = bless {
       'tagname'=>$tagname,
       'attrs'=>{%attrs},
       'content'=>[], 
       'startline'=>$expat->current_line, 
       'startcol'=>$expat->current_column, 
   }; 
   if (@$SMelt::stack) { 
      push(@{$SMelt::stack->[$#SMelt::stack]->{'content'}},$entry); 
   } else { 	# no stack yet => an object at top level. Must be one of these.
      push(@$SMelt::toplevel,$entry); 
   } 
   push(@$SMelt::stack,$entry); 
   &main::debug("end   handle_start '$tagname'\n",3); 
} 

sub handle_end { 
   my $expat = shift; 
   my $tagname = shift; 
   &main::debug("begin handle_end '$tagname' (line "
        . $expat->current_line . ")\n",3); 
   if ($tagname ne $SMelt::stack->[$#SMelt::stack]->{'tagname'}) { 
      die "<$SMelt::stack->[$#SMelt::stack]->{'tagname'}> closed by </$tagname>!\n"; 
   } else { 
      ${$SMelt::stack}[$#{SMelt::stack}]->{'endline'}
	 =$expat->current_line; 
      ${$SMelt::stack}[$#{SMelt::stack}]->{'endcol'}
	 =$expat->current_column; 
      pop(@$SMelt::stack); 
   } 
   &main::debug("end   handle_end '$tagname'\n",3); 
} 

sub handle_char { 
   my $expat = shift; 
   my $chars = shift; 
   &main::debug("begin handle_char '$chars' (line "
        . $expat->current_line . ")\n",3); 
   $chars =~ s/[\s\r\n]//g; 
   $chars =~ s/\\s/ /g; 
   $chars =~ s/\\t/\t/g; 
   $chars =~ s/\\r/\r/g; 
   $chars =~ s/\\n/\n/g; 
   $chars =~ s/\\\\/\\/g; 
   while ($chars =~ /(\\[0-9][0-9][0-9])/) { 
        my $replace = $1; 
        my $val = substr($replace,1,1)*8*8
                + substr($replace,2,1)*8
                + substr($replace,3,1); 
	&main::debug("replacing $replace with chr($val)\n",11); 
	$val = chr($val); 
	$chars =~ s/(\\[0-9][0-9][0-9])/$val/; 
   } 
   goto out if $chars eq ''; 
   if (@$SMelt::stack) { 
      my $place = $SMelt::stack->[$#SMelt::stack]->{'content'}; 
      if (@$place and ref $place->[$#$place] ne 'SMelt') { 
         $place->[$#$place] .= $chars; 
      } else { 
         push(@{$SMelt::stack->[$#SMelt::stack]->{'content'}},$chars); 
      } 
   } else { 
      push(@$SMelt::toplevel,$chars); 
   } 
out:
   &main::debug("end   handle_char '$chars'\n",3); 
} 

#####
# perl parsing subsystem: these routines enable easily 
# readable perl to be embedded in babble scripts by escaping the
# perl before parsing the XML
#####

# read a babble file and escape embedded perl 
sub readFileAndEscape { 
   my $file = shift; 
   die "file $file doesn't exist!"  if ! -e $file; 
   die "file $file isn't readable!"  if ! -r $file; 
   open(FILE,"<$file") or die "can't read file: $!"; 
   my @stuff = (<FILE>); close FILE; 
   shift(@stuff) if $stuff[0] =~ /^#!/;
   return &escapeCode(join('',@stuff)); 
} 

# read standard input and escape if necessary 
sub readStdinAndEscape { 
   my @stuff = (<STDIN>); 
   shift(@stuff) if $stuff[0] =~ /^#!/;
   return &escapeCode(join('',@stuff)); 
} 

#####
# given input as an array of lines, escape embedded perl 
# This is a dirty hack that doesn't result in compliant XML
# perl starts with a <perl ...> tag and ends with a </perl> tag. 
# tags can be multiline. 
# - search for first tag, then search for first tag end. 
# - use global search context to simplify scanner. 
# - inappropriate nesting results in escaped tags!
#####

sub escapeCode { 
   my $instuff = shift; 
   my $outstuff = ''; 
   my $inperl = 0; 
   # first elide comments except inside strings
   $instuff =~ s/#.*\n//g; 
   # now substitute magic characters
   while ($instuff =~ m/<perl[^>]*>/gi) { 
      my $where = pos $instuff; 
      $outstuff .= substr($instuff,0,$where); 
      $instuff = substr($instuff,$where); 
      if ($instuff =~ m/<\/perl>/gi) { 
         my $end = pos $instuff; 
         my $perlend = $end - 7; 
         $outstuff .= &escapePerl(substr($instuff,0,$perlend))
            . substr($instuff,$perlend,7); 
         $instuff = substr($instuff,$end); 
      } 
   } 
   $outstuff .= $instuff; 
   return $outstuff; 
} 

# escape embedded stuff in perl 
sub escapePerl { 
   my $stuff = shift; 
   $stuff =~ s/\&/\&amp;/g; 
   $stuff =~ s/</\&lt;/g; 
   $stuff =~ s/>/\&gt;/g; 
   $stuff =~ s/"/\&quot;/g; 
   $stuff =~ s/ /\\s/g; 
   $stuff =~ s/\t/\\t/g; 
   $stuff =~ s/\r/\\r/g; 
   $stuff =~ s/\n/\\n/g; 
   return $stuff; 
} 

# after parse, unescape perl content!
sub unescapePerl { 
   my $stuff = shift; 
   $stuff =~ s/\&amp;/\&/g; 
   $stuff =~ s/\&lt;/</g; 
   $stuff =~ s/\&gt;/>/g; 
   $stuff =~ s/\&quot;/"/g; 
   $stuff =~ s/\\s/ /g; 
   $stuff =~ s/\\t/\t/g; 
   $stuff =~ s/\\r/\r/g; 
   $stuff =~ s/\\n/\n/g; 
   return $stuff; 
} 

#####
# this package does I/O with a process and can monitor both sides 
# of the conversation (potentially).  We start by creating a pseudo-tty and 
# connecting process STDIN and STDOUT to it. Thus we can send and 
# read stuff from it. 
#####

# usage: 
# use Data::Dumper; 
# my $foo = new Spawn ("cu -l cua/b -b 8");
# my $foo = new Spawn ("telnet andante");
# my $foo = new Spawn ("tip cuab");
# print $foo->poll; 
# $foo->put("\r"); 
# print $foo->poll; 
# $foo->put_noecho("login couch\r"); 
# print $foo->get(["couch\r\n"])->[0]; 
# print $foo->poll; 
# sleep 10; 
# $foo->close;
# exit 0;

package Spawn; 
use Data::Dumper; 
use IO::Pty; 
require POSIX;
use POSIX ":sys_wait_h";

# at beginning of execution there are no open Spawn streams
sub BEGIN { 
    $Spawn::them = []; 
} 

#####
# create a new Spawn element from a command
# this places it into a spawn stack 
#####

sub new { 
    my $pname = shift; 
    my $command  = shift; 
    my $self = { @_ }; 
    $self->{'command'} = $command; 
    $self->{'master'} = new IO::Pty; 
    $SIG{CHLD} = \&reaper;
    $self->{'pid'} = fork(); 	       	# new process
    $self->{'timeout'} = 10 if ! defined $self->{'timeout'}; 
    $self->{'buffer'} = ""; 		# empty buffer
    push(@$Spawn::them,$self);        	# make a copy 
    if (! $self->{'pid'}) { 		# child execs subprogram
        setpgrp(0,0); 			# become process leader. 
        my $master = $self->{'master'}; 
	my $slave = $master->slave;	# get tty for slave. 
	close($master); 	        # close master side of pipe 
	# dup STDIN, STDOUT, STDERR to PSEUDO-TTY
	open(STDIN, "<&".fileno($slave)) || (sleep(5),die "Cannot open STDIN");
	open(STDOUT,">&".fileno($slave)) || (sleep(5),die "Cannot open STDOUT");
	open(STDERR,">&STDOUT")          || (sleep(5),die "Cannot open STDERR");
	close($slave);			# close slave; dups stay open. 
	# execute program with dup in effect, so output can be caught. 
	exec $self->{'command'} 
 	   or die "Cannot exec $self->{'command'}: $!"; 
    } else { 				# parent sets up to read and write
        close($self->{'master'}->slave);   # close slave side of pipe 
        select($self->{'master'}); $|=1;	# autoflush
        select(STDOUT); 
        return bless $self, $pname; 
    } 
} 

#####
# only top element of spawn is used at any one time
#####

sub top { 
   return $Spawn::them->[$#$Spawn::Them]; 
} 

#####
# put characters and expect an echo. 
#####

sub put { 
    my $self = shift; 
    my $string = shift; 
    my $pattern = shift; 
    $self->send($string); 
    return $self->get($pattern) if defined $pattern;; 
    return ["","",0]; 
} 

#####
# put characters without expecting an echo. 
# this overrides pattern matching 
#####

sub put_noecho { 
    my $self = shift; 
    my $string = shift; 
    return $self->put($string);
} 

#####
# check for a series of patterns until a timeout. 
# first pattern match wins; this means SHORTEST pattern. 
# return array ref containing characters, pattern, and index
#####

sub get { 
    my $self = shift; 
    my @patterns = @_; 
    &main::debug("invoked get\n",4); 
    my $i; 
    for ($i=0; $i<@patterns; $i++) { 
        &main::debug(" get: pattern $i: /$patterns[$i]/\n",4); 
    } 
    if (! @patterns) { 
        &main::debug("get: matched // with '' (no patterns)\n",4); 
	return ["","",0]; 
    } 
    my $i; 
    for ($i=0; $i<@patterns; $i++) { 
        if ($patterns[$i] eq '') { 
           &main::debug("get: matched // with '' (position $i)\n",4); 
           return ["","",$i] 
        } 
    } 

    # simulate 'typing' the input buffer until a match or continue
    # we have to do this because a naive match would match 
    # only the LAST instance of a pattern. We want the FIRST. 

    my $len = length($self->{'buffer'}); 
    my $in = ''; 			# input buffer
    my $j; for ($j=1; $j<=$len; $j++) {
	$in = substr($self->{'buffer'},0,$j); 
	my $i; for ($i=0; $i<@patterns; $i++) { 
	    my $pat = $patterns[$i]; 
	    if ($in =~ /($pat)/) { 				
		$self->{'buffer'} = substr($self->{'buffer'},$j); 
                &main::debug("get: matched /($pat)/ with '$in' (position $i)\n",4); 
		return [$in,$pat,$i]; 
	    } 
	} 
    } 

    my $tty = $self->{'master'}; 
    my $secs = $self->{'timeout'}; 
    my ($rin,$win,$ein) = ('','','');
    vec($rin, fileno($tty),  1) = 1; # select for pseudo-tty read
    select($tty); $| = 1; # autoflush 
    select(STDOUT); 

    my $ret = eval {
        local $SIG{'__DIE__'} = undef;                   # override die action. 
        local $SIG{'ALRM'} = sub { die "alarm\n" };      # NB \n required
        alarm $secs;

	# do the following until the timeout is reached
	while (1) { 
	    my ($rout,$wout,$eout,$nfound,$timeleft);
	    ($nfound,$timeleft) = select($rout=$rin,$wout=$win,$eout=$ein,$secs);
# print STDERR "nfound=$nfound timeleft=$timeleft\n"; 
	    my $buf; 
	    my $read = sysread($tty, $buf, 1);
# print STDERR "buf=$buf\n"; 
	    if (!defined $read or !$read) { 
                &main::debug("get: match failed\n",4); 
		return [$in,undef,undef]; 
	    } 
	    $in .= $buf; 
            &main::rawout($buf); 
            &main::debug("get: got \'". &SMelt::DumpString($in) . "\'\n",4); 
            my $i; 
            for ($i=0; $i<@patterns; $i++) { 
		my $pat = $patterns[$i]; 
                if ($in =~ /$pat/) { 
		    alarm 0; 
		    &main::debug("get: matched /($pat)/ with '$in' (position $i)\n",4); 
	            return [$in,$pat,$i]; 
                } 
            } 
        }
    } ; 
    die "error in get!" if $@ && $@ ne "alarm\n";# propagate errors
    if ($@) {
        # timed out
	alarm 0; 
	$self->{'buffer'} = $in; 	# save for next run 
        &main::debug("get: timed out with buffer '$in'\n",4); 
        return [$in,undef,undef]; 
    } else {
        # didn't time out
	alarm 0; 
	return $ret; 
    }
} 

#####
# forward controlling input terminal to device and 
# vice-versa, enabling a conversation. 
# during the conversation, record what is typed
# by BOTH sides. End when user types control-D 
#####

sub converse { 
    my $self = shift; 

    my $in = []; 			# input buffer
    my $tty = $self->{'master'}; 

    my ($rin,$win,$ein) = ('','','');
    vec($rin, fileno($tty),  1) = 1; # select for read from slave
    vec($rin, fileno(STDIN),  1) = 1; # select for read from STDIN
    select($tty); $| = 1; # autoflush 
    select(STDOUT); 

    my $buf; 
    while (1) { 
	my ($rout,$wout,$eout,$nfound,$timeleft);
	($nfound,$timeleft) = select($rout=$rin,$wout=$win,$eout=$ein,0);
        if (vec($rout, fileno($tty), 1) == 1) { 
	    my $read = sysread($tty, $buf, 1);
            if ($read) { 
                syswrite(STDERR,$buf,length($buf)); 
	        if (@$in>0 && $in->[$#$in]->[1] eq 'put' 
                  and $in->[$#$in]->[0] eq $buf) { 
                   $in->[$#$in]->[1] = 'putget'; 
                } elsif (@$in>0 && $in->[$#$in]->[1] eq 'get') { 
                   $in->[$#$in]->[0] .= $buf;  
                } else { 
                   push(@$in, [$buf,'get']); 
                } 
            } else { 
                last; 
            } 
        } elsif (vec($rout, fileno(STDIN), 1) == 1) { 
	    my $read = sysread(STDIN, $buf, 1);
            if ($read) { 
                syswrite($tty,$buf,length($buf)); 
                push(@$in, [$buf,'put']); 
            } else { 
                last; 
            } 
        } 
    }

    # go through the code, compressing things where possible. 
    my $i; 
    for ($i=0; $i<scalar(@$in)-1; $i++) { 
       if ($in->[$i]->[1] eq 'put'
        && $in->[$i+1]->[1] eq 'get'       
        && $in->[$i]->[0] eq $in->[$i+1]->[0]) { 
         $in->[$i]->[1] = 'putget'; 
         splice(@$in,$i+1,1); 
# print STDERR "combining p+g for $in->[$i]->[0]\n"; 
         redo; 
       } 
    } 
    for ($i=0; $i<scalar(@$in)-1; $i++) { 
       if ($in->[$i]->[1] eq $in->[$i+1]->[1]) { 
         $in->[$i]->[0] .= $in->[$i+1]->[0]; 
# print STDERR "combining $in->[$i]->[1] to get $in->[$i]->[0]\n"; 
         splice(@$in,$i+1,1); 
         redo; 
       } 
    } 
    # now print out what you see. 
    my $out = ''; 
    for ($i=0; $i<@$in; $i++) { 
      if ($in->[$i]->[1] eq 'get') { 
         $out .= "<get>" . &SMelt::DumpString($in->[$i]->[0]) . "</get>\n"; 
      } elsif ($in->[$i]->[1] eq 'put') { 
         $out .= "<put><noecho>" . &SMelt::DumpString($in->[$i]->[0]) . "</noecho></put>\n"; 
      } else { 
         $out .= "<put>" . &SMelt::DumpString($in->[$i]->[0]) . "</put>\n"; 
      } 
    } 
    return $out; 
} 

#####
# low-level read from child until there are n seconds of silence. 
# this is NOT used in babble; it's for testing connections 
#####

sub poll { 
    my $self = shift; 
    my $tty = $self->{'master'}; 
    my $secs = $self->{'timeout'}; 
    my ($rin,$win,$ein) = ('','','');
    vec($rin, fileno($tty),  1) = 1; # select for pseudo-tty read
    select($tty); $| = 1; # autoflush 
    select(STDOUT); 
    my $in = ''; 
    while (1) {
        my ($rout,$wout,$eout,$nfound,$timeleft);
        ($nfound,$timeleft) = select($rout=$rin,$wout=$win,$eout=$ein,$secs);
        if ($nfound<=0) { # || !vec($rout, fileno($tty), 1); 
            &main::debug("poll in=$in\n",9); 
            return $in; 
        } 
        my $buf; 
        my $read = sysread($tty, $buf, $nfound);
        if (!defined $read or !$read) { 
            &main::debug("poll in=$in\n",9); 
            return $in; 
        } 
        $in .= $buf; 
    } 
    &main::debug("poll in=$in\n",9); 
    return $in; 
} 

#####
# close a device feed. 
#####

sub close { 
    my $self = shift; 
    my $i; 
    for ($i=0; $i<@$Spawn::them; $i++) { 
        if ($Spawn::them->[$i] == $self) { 
            splice (@$Spawn::them,$i,1);
        } 
    } 
    my $pgrp = getpgrp($self->{'pid'}); 
    kill 'TERM', -$pgrp or &main::debug("kill TERM,-$pgrp failed: $!",9); 
    $self->{'master'}->close; 
    sleep 1; 
    kill 'KILL', -$pgrp or &main::debug("kill KILL,-$pgrp failed: $!",9)
	if $self->running; 
} 

#####
# simple test for whether a particular spawn is active or has been killed
# upon kill the master list of active Spawns is spliced so that 
# the inactive one is no longer present. This tests whether a given
# element has been spliced out => closed. 
#####

sub running { 
    my $self=shift; 
    my $i; for ($i=0; $i<@$Spawn::them; $i++) { 
        return 1 if $self->{'pid'} == $Spawn::them->[$i]->{'pid'}; 
    } 
    return undef; 
} 

#####
# low level send just sends characters to device. 
# this is just used in put and put_noecho. 
# babble never calls it directly. 
#####

sub send { 
    my $self = shift; 
    my $tty = $self->{'master'}; 
    die "can't send from child" if ! defined $tty; 
    my $data = shift; 
    return syswrite($tty,$data,length($data)); 
} 

#####
# close all streams in preparation for power down. 
#####

sub clear { 
    my $self; 
    foreach $self (@$Spawn::them) { $self->close; } 
} 

#####
# read from first stream that gives data
# this is NOT normally used by babble and is left in for 
# debugging babble only 
#####

sub readem { 
    my $self; 
    my $secs = 0; 
    my ($rin,$win,$ein) = ('','','');
    foreach $self (@$Spawn::them) { 
	my $tty = $self->{'master'}; 
	$secs = $self->{'timeout'} if $self->{'timeout'}>$secs; 
	vec($rin,fileno($tty),1) = 1;	# select for pseudo-tty read
    } 
    my $in = ''; 
    while (1) {
        my ($rout,$wout,$eout,$nfound,$timeleft);
        ($nfound,$timeleft) = select($rout=$rin,$wout=$win,$eout=$ein,$secs);
# print STDERR "nfound=$nfound\n"; 
        if ($nfound<=0) { # || !vec($rout, fileno($tty), 1); 
# print STDERR "poll in=$in\n"; 
            return undef; 
        } 
        foreach $self (@$Spawn::them) { 
	    my $tty = $self->{'master'}; 
            if (vec($rout,fileno($tty),1)) { 
		my $buf = ''; 
	        my $read = sysread($tty,$buf,1);
		$self->{'buffer'} .= $buf if defined $read and $read; 
            } 
        } 
    } 
} 

#####
# reap dead child processes to avoid zombies. 
# when a child dies, reap it and splice its record
# out of the active list. This is checked above to indirectly
# detect stream deaths in the active thread.
#####

sub reaper {
    my $waitedpid = wait;
    &main::debug("reaped $waitedpid\n",9); 
    
    # remove this process from the list of open ones right now. 
    my $i; 
    for ($i=0; $i<@$Spawn::them; $i++) { 
        if ($Spawn::them->[$i]->{'pid'} == $waitedpid) { 
            splice (@$Spawn::them,$i,1);
        } 
    } 
    # loathe sysV: it makes us not only reinstate
    # the handler, but place it after the wait
    $SIG{CHLD} = \&reaper;
}


#####
# perl execution package handles import and export from 
# perl scripts. Each script is executed in a sandbox
# context into which named values are injected. 
# The script should refrain from moving outside its 
# context and should simply create variables to 
# be exported. 
#####

package Sandbox::Control; 

use Data::Dumper; 

BEGIN { 
    $Sandbox::Control::scalartmp = "UNKNOWN"; 
} 

###
# Do an evaluation in a closed context and return the results. 
# We can't change a reference without changing its contents. 
# So the export array and all export variables will be changed directly 
# unless we do something special. from an efficiency standpoint, 
# this is great, but from a correctness standpoint, it loses. 
# so we have to copy all inputs over to avoid aliasing. 
###
sub eval { 
   my $perl = shift; 
   my $scope = shift; 
   my $import = shift; 
   my $export = shift; 
# print STDERR "perl=$perl\n"; 
# print STDERR "scope=".Dumper($scope); 
# print STDERR "import=$import\n"; 
# print STDERR "export=$export\n"; 
   &Sandbox::Control::clear; 
   &Sandbox::Control::import($scope,$import) 
	if defined $scope and defined $import; 
   my $ret = &Sandbox::Control::evalInContext($perl); 
   if ($@) { 
      &main::inform("in Perl code:\n", "$perl\n"); 
      die @$; 
      # return $ret; # flag that things went seriously wrong
   } 
# print STDERR "doing export!\n"; 
   &Sandbox::Control::export($scope,$export) 
	if defined $scope and defined $export; 
# print STDERR "did export!\n"; 
   return $ret; 
} 

###
# clear pattern space for eval
###
sub clear { 
   my ($key,$value); 
   while (($key,$value) = each %Sandbox::) { delete $Sandbox::{$key}; } 
} 

### ###
### # perform a deep copy of the hash
### ###
### 
### sub copy { 
###    my $in = shift; 
###    my $out; 
###    if (ref $in eq 'ARRAY') { 
###       $out = []; 
###       my $e; foreach $e (@$in) { push(@$out,&copy($e)); } 
###    } elsif (ref $in eq 'HASH') { 
###       $out = {}; 
###       my $k, $v; while (($k,$v) = each %$in) { $out->{$k}=&copy($v); } 
###    } else { 
###       $out = $in; 
###    } 
###    return $out; 
### } 

#####
# parse an import/export specification
# this is a list of types of things that is used to check whether 
# particular references are of the correct type.  The parse outputs
# an architypal structure that the variable represents. 
# The main purpose of the fine-grained information is to enable flow 
# analysis of the resulting data streams without executing the script. 
#####

sub spec { 
   my $spec = shift; 
   $spec =~ s/[\s\n]//g; # no white space
   my $out = {}; 
   if ($spec ne '') { 
      # parse at commas not inside braces
      my $braces=0; 
      my $brackets=0; 
      my $start = 0; 
      my $len = length($spec); 
      my $i; for ($i=0; $i<$len; $i++) { 
	  my $c = substr($spec,$i,1); 
	  $braces++ if $c eq '{'; 
	  $braces-- if $c eq '}'; 
	  $brackets++ if $c eq '['; 
	  $brackets-- if $c eq ']'; 
	  if ($c eq ',' and $brackets == 0 and $braces == 0) {
	      my $sub = substr($spec,$start,$i-$start); $start=$i+1; 
	      my $stuff = &specname($sub); 
	      my $name = $stuff->[0]; 
	      my $type = $stuff->[1]; 
	      $out->{$name}=$type if defined $name and defined $type; 
	  } 
      } 
      my $sub = substr($spec,$start,$len-$start); 
      my $stuff = &specname($sub); 
      my $name = $stuff->[0]; 
      my $type = $stuff->[1]; 
      $out->{$name}=$type if defined $name and defined $type; 
   } 
   return $out; 
} 

sub specname { 
   my $stuff = shift; 
   my $name = undef;  
   my $type = undef; 
   if ($stuff =~ s/^([a-zA-Z][a-zA-Z0-9]*)//) { 
      $name = $1; 
      if ($stuff eq '') { 
	 $type = $Sandbox::Control::scalartmp; 
      } elsif ($stuff =~ s/^\{(.*)\}$/\1/) { 
	 $type = &spec($stuff); 
      } elsif ($stuff =~ s/^\[(.*)\]$/\1/) { 
	 $type = [ &spec($stuff) ] ; 
      } else { 
	 &main::inform("no type inferred for $name from $stuff\n"); 
      } 
   } else { 
      &main::inform("name of specification garbled in $stuff!\n"); 
   } 
   return [$name,$type]; 
} 

###
# import a scope into a Perl namespace verbatim
# this is a matter of parsing the import list
# and querying the scope for each value. 
###

sub import { 
   my $scope = shift; 	# instance of SMscope
   my $what = shift; 	# formal specification of what to import
   my $errors = 0;
   my $spec = &spec($what); 
   my ($key,$val,$type); 
   &Sandbox::Control::clear; 
   while (($key,$type) = each %$spec) { 
# print STDERR "import: got key $key\n"; 
      my $val = $scope->val($key); 
# print STDERR "import: got val $val\n"; 
      if (defined $val) { 
         my $hash = &SmToPerl($val); 
# print STDERR "import: got hash ".Dumper($hash); 
         if (&conformal($type,$hash)) { 
            eval "\$Sandbox::$key = ".'$hash'; 
	 } else { 
	    &main::inform("import type not conformal for value $key!\n"); 
            &main::inform("hash=" . Dumper($hash)); 
            &main::inform("type=" . Dumper($type)); 
	    $errors++; 
         } 
      } else { 
	&main::inform("no value to import for $key\n"); 
      } 
   } 
   return $errors==0; 
} 


###
# test whether an import will work. 
###

sub fakeImport { 
   my $scope = shift; 	# instance of SMscope
   my $what = shift; 	# formal specification of what to import
   my $errors = 0;
   my $spec = &spec($what); 
   my ($key,$val,$type); 
   while (($key,$type) = each %$spec) { 
      my $val = $scope->val($key); 
      if (defined $val) { 
         my $hash = &SmToPerl($val); 
         if (! &conformal($type,$hash)) { 
	    &main::inform("import type not conformal for value $key!\n"); 
            &main::inform("hash=" . Dumper($hash)); 
            &main::inform("type=" . Dumper($type)); 
	    $errors++; 
         } 
      } else { 
	&main::inform("no value to import for $key\n"); 
      } 
   } 
   return $errors==0; 
} 

###
# export differences between input and output only. 
# these are placed into an 'overlay' or 'shadowing' frame
# this isn't used by Babble but is kept in for documentation purposes. 
###

sub export { 
   my $scope = shift; 	# instance of SMscope
   my $what = shift; 	# formal specification of what to export
   my $errors = 0; 
   my $spec = &spec($what); 
   my $key; my $glob; my $val; my $type; 
   while (($key,$type) = each %$spec) { 
# print STDERR "key=$key type=$type\n"; 
      $glob = $Sandbox::{$key}; 
      if (defined $glob) { 
         $val  = ${*{$glob}}; 
# print STDERR "key=$key type=$type val=$val\n"; 
# print STDERR "calling conformal\n"; 
         if (! &conformal($type,$val)) { 
# print STDERR "called conformal: not\n"; 
	    &main::inform("export type not conformal for perl variable \$$key!\n"); 
	    $errors++; 
            next; 
         } 
# print STDERR "calling consistent\n"; 
         if (ref $val eq 'ARRAY' and ! &consistent($val)) { 
# print STDERR "called consistent:not\n"; 
	    &main::inform("exported perl array reference variable \$$key contains inconsistent types!\n"); 
	    $errors++; 
            next; 
         } 
# print STDERR "called consistent:yes\n"; 
         if (! &valid_var($val)) { 
	    &main::inform("export value of perl variable \$$key incompatible with Babble!\n"); 
	    $errors++; 
            next; 
         } 
 	 &main::debug("setting $key to " . Dumper($val),9); 
# print STDERR "calling set\n"; 
         $scope->set({$key=>&PerlToSm($val)}); 
# print STDERR "called set\n"; 
      } 
   } 
   return ($errors == 0); 
} 

###
# export architypal values for type-checking
###

sub fakeExport { 
   my $scope = shift; 	# instance of SMscope
   my $what = shift; 	# formal specification of what to export
   my $spec = &spec($what); 
   my $key; my $type; 
   while (($key,$type) = each %$spec) { 
      $scope->set({$key=>&PerlToSm($type)}); 
   } 
   return 1; 
}

###
# transform Perl values into export form
###
sub PerlToSm { 
   my $thing = shift; 
   if (ref $thing eq 'ARRAY') { 
      my $out = []; 
# print STDERR "thing is array; doing for loop\n"; 
      my $i; for ($i=0; $i<@$thing; $i++) { 
         push(@$out,&PerlToSm($thing->[$i])); 
      } 
# print STDERR "thing is array; end for loop\n"; 
      return new SMrestack(new SMrepeat($out,'dynamic')); 
   } elsif (ref $thing eq 'HASH') { 
      my $key; my $value; 
      my $out = {}; 
# print STDERR "thing is hash; doing while\n"; 
      while (($key,$value) = each %$thing) { 
         $out->{$key} = &PerlToSm($value); 
      } 
# print STDERR "thing is hash; end while\n"; 
      return new SMfrstack(
         new SMframe($out, 'case', 'dynamic'), 
         new SMframe({}, 'case', 'dynamic')
      ); 
   } else { 
      return $thing . ""; 
   } 
} 

###
# transform babble values into Perl form
###
sub SmToPerl { 
   my $thing = shift; 
   if (ref $thing eq '') { return $thing; } 
   else { return $thing->hash; } 
} 

###
# make up a deletion tag, blessed into this class, appropriately
###

sub deltag { 
   my $prototype = shift; 
   return bless [] if ref $prototype eq 'ARRAY'; 
   return bless {} if ref $prototype eq 'HASH'; 
   return bless \$Sandbox::Control::scalartmp; 
} 

###
# makes sure two variables are deeply equal, which means
# identical structure, all leaves are strings, and 
# corresponding leaves are equal. 
###
sub equal { 
   my $in = shift; 
   my $out = shift; 

   # obviously unequal if reftypes different
   return undef if ref $in ne ref $out;

   # Hashes are equal if they have the same keys and corresp. values are equal
   if (ref $in eq 'HASH') { 
      my @inkeys = sort keys %$in; 
      my @outkeys = sort keys %$out; 
      return undef if ! &equal([@inkeys],[@outkeys]); 
      my @allkeys = sort (@inkeys,@outkeys); 
      my $i; for ($i=0; $i<@allkeys-1; $i++) { 
	 splice(@allkeys,$i,1) if $allkeys[$i] eq $allkeys[$i+1]; 
      } 
      my $key; foreach $key (@allkeys) { 
	 return undef if ! defined $in->{$key}; 
	 return undef if ! defined $out->{$key}; 
	 return undef if ! &equal($out->{$key},$in->{$key}); 
      } 

   # arrays are equal if corresponding values are equal...
   } elsif (ref $in eq 'ARRAY') { 
      return undef if @$in != @$out; 
      my $i; for ($i=0; $i<@$in; $i++) { 
	  return undef if ! &equal($in->[$i] , $out->[$i]); 
      } 

   # strings are equal if they're identical...
   } elsif (ref $in eq '') { 	# not an array or hash -> must be string
      return undef if $in ne $out; 

   # I don't know how to compare anything else...
   } else { 
      return undef; 		# can't tell; discretion = better part of valor
   } 

   return 1; 			# got through all tests
} 

# Insure that return values from Perl are babble type-conformal: 
# this is a matter of making sure that arrays, hashes, etc., occur
# at the same levels and that consistency is preserved. 
# a hash is conformal with another if its elements that match are conformal
# an array is conformal if subelements that match in name are conformal. 

sub conformal { 
   my $in = shift; 
   my $out = shift; 
   my $diff = {}; 

   # elements with different reftypes aren't conformal
   return undef if ref $in ne ref $out;

   if (ref $out eq 'HASH') { 

      # hashes are conformal if elements with the 
      # same key have the same structural type. 
      my @inkeys = keys %$in; 
      my @outkeys = keys %$out; 
      my @allkeys = sort (@inkeys,@outkeys); 
      my $i; 
      for ($i=0; $i<@allkeys-1; $i++) { 
	 splice(@allkeys,$i,1) if $allkeys[$i] eq $allkeys[$i+1]; 
      } 
      my $key; foreach $key (@allkeys) { 
	 return undef 
	    if defined $in->{$key} 
	    and defined $out->{$key} 
	    and ! &conformal($out->{$key},$in->{$key}); 
      } 
      return 1; 

   } elsif (ref $out eq 'ARRAY') { 

      # arrays are conformal if every element is a hash with the same keys, 
      # and every set of keys is type-conformal with every other. 
      # nothing needs to be type-conformal unless internal subkeys match. 

      # implicit type coherence (conformality of implied defaults
      # and default image completeness) is handled later inside babble. 

      ###
      # every element of an array must be a hash. 
      ###
      my $i; for ($i=0; $i<@$out; $i++) { 
	 return undef if ref $out->[$i] ne 'HASH'; 
      } 

      ###
      # self-consistency: every element of every output hash
      # must be conformal with every other one with the same name. 
      ###
      return undef if ! &consistent($out); 
      return undef if ! &consistent($in); 


      ###
      # non-contravariance: if input and output array elements
      # contain the same element, it must have the same structure. 
      # (inductive typing) 
      ###

      # make a list of all keys in input hashes
      my @inkeys = (); 
      for ($i=0; $i<@$in; $i++) { push(@inkeys,keys %{$in->[$i]}); } 
      @inkeys = sort(@inkeys); 
      for ($i=0; $i<@inkeys-1; $i++) { 
	 splice(@inkeys,$i,1) if $inkeys[$i] eq $inkeys[$i+1]; 
      } 

      # get a global key list 
      my @allkeys = @inkeys; 

      # check for contravariance between input and output
      # this is a brute force method that takes too long. 
      my $key; foreach $key (@allkeys) { 
         my $i; for ($i=0; $i<@$in; $i++) { 
            my $j; for ($j=0; $j<@$out; $j++) { 
               if (defined $in->[$i]->{$key} and defined $out->[$j]->{$key}) { 
	          if (!&conformal($in->[$i]->{$key},$out->[$j]->{$key})) { 
                      &main::inform("input element $i and output element $j"
                           . " aren't conformal!\n"); 
                      return undef; 
                  } 
	       } 
            } 
         } 
      } 

      ### # every element must have the same keys
      ### # this is too strict for allowing defaults. 
      ### # instead, should insure that same keys are exposed
      ### # in each element context. 
      ### my @keys = sort keys %{$out->[0]}; 
      ### for ($i=1; $i<@$out; $i++) { 
      ###    my @nk = sort keys %{$out->[$i]}; 
      ###    return undef if ! &equal([@keys],[@nk]); 
      ### } 

      ### # self-consistency: every element type conformal with the first
      ### # again, too limiting; every element should be type-conformal 
      ### # with every exposed superscope default. and every default
      ### # should be exposed at the proper time. 
      ### for ($i=1; $i<@$out; $i++) { 
      ###    return undef if ! &conformal($out->[0] , $out->[$i]); 
      ### } 

      ### # invariance: every element must be type conformal with the first
      ### # element of the input. 
      ### if (@$in>0) { 
      ###    for ($i=1; $i<@$out; $i++) { 
      ###       return undef if ! &conformal($in->[0] , $out->[$i]); 
      ###    } 
      ### } 
   } 

   return 1; 
} 

###
# is an element self-consistent? 
###
sub consistent { 
   my $out = shift; 
   # make a list of all keys in output hashes
   my @outkeys = (); 
   my $i; for ($i=0; $i<@$out; $i++) { push(@outkeys,keys %{$out->[$i]}); } 
   @outkeys = sort(@outkeys); 
   for ($i=0; $i<@outkeys-1; $i++) { 
      splice(@outkeys,$i,1) if $outkeys[$i] eq $outkeys[$i+1]; 
   } 
# print STDERR "consistent: keys=@outkeys\n"; 

   # if any two array elements contain the same element, 
   # it must have the same structure for both 
   # (inductive parallel structure) 
   my $j; 
   my $key; 
   foreach $key (@outkeys) { 
      for ($i=0; $i<@$out-1; $i++) { 
	 for ($j=$i+1; $j<@$out; $j++) { 
	    if (defined $out->[$i]->{$key} and defined $out->[$j]->{$key}) { 
	       if (!&conformal($out->[$i]->{$key},$out->[$j]->{$key})) { 
		   print STDERR "array elements $i and $j aren't type-conformal!\n"; 
                   print STDERR "element $i: ".Dumper($out->[$i]->{$key}); 
                   print STDERR "element $j: ".Dumper($out->[$j]->{$key}); 
		   return undef; 
	       } 
	    } 
	 } 
      } 
   } 
   return 1; 
} 
# validity checker checks that structural declarations are valid in 
# foreign scope before export. A valid structural scope consists
# of cases (hashes), repeats (arrays of hashes) and scalars. 
# all else constitutes a contravariance violation in Babble's hierarchy. 

sub valid { 
   my $thing = shift; # assume top level object = HASH
   return undef if ref $thing ne 'HASH'; 
   # next level of object can be hash or array of hash. 
   my $key; my $value; 
   while (($key,$value) = each %$thing) { 
      return undef if ! &valid_var($value); 
   } 
   return 1; 
} 

sub valid_var { 
   my $value = shift; 
   if (ref $value eq 'HASH') { 
      return undef if ! &valid($value); 
   } elsif (ref $value eq 'ARRAY') { 
      my $i; 
      for ($i=0; $i<@$value; $i++) { 
	 return undef if ref $value->[$i] ne 'HASH'; 
	 return undef if ! &valid($value->[$i]); 
      } 
   } 
   return 1; 
} 

package Sandbox; 

# to execute something in a particular package context, 
# create a subroutine that is DEFINED in the appropriate
# package but NAMED in another! This is so Sandbox contains
# ONLY variables.  This means we can clear that namespace
# without affecting anything else. 

no strict; 
sub Sandbox::Control::evalInContext { eval shift } 
use strict; 
no strict "refs"; 

1;