#! /usr/local/bin/perl
#
#  MUSH assembler
#

@INC = (".", @INC, "/users/en-ecen/popiel/lib");

require "socket.ph";
require "fcntl.ph";

$TCP = 6;
$sockaddr = "S n a4 x8";
$worldlist = "$ENV{HOME}/.tinytalk";
$outputprefix = "*-*-* OUTPUTPREFIX *-*-*";
$outputsuffix = "*-*-* OUTPUTSUFFIX *-*-*";

# return string of address of peer connection
sub peer_info {
	local ($socket) = @_[0];
	local ($sockdata, $af, $port);
	local ($name, $aliases, $type, $len, $host);

	$sockdata = getpeername ($socket);
	($af,$port,$inetaddr) = unpack ($sockaddr,$sockdata);
	@inetaddr = unpack ('C4',$inetaddr);
	$dotaddr = join ('.', @inetaddr);
	($name, $aliases, $type, $len, $host) =
		gethostbyaddr ($inetaddr, &AF_INET);

	return "$name ($dotaddr)  $port";
}

# return string of address of this end of socket
sub sock_info {
	local ($socket) = @_[0];
	local ($sockdata, $af, $port);
	local ($name, $aliases, $type, $len, $host);

	$sockdata = getsockname ($socket);
	($af,$port,$inetaddr) = unpack ($sockaddr,$sockdata);
	@inetaddr = unpack ('C4',$inetaddr);
	$dotaddr = join ('.', @inetaddr);
	($name, $aliases, $type, $len, $host) =
		gethostbyaddr ($inetaddr, &AF_INET);

	return "$name ($dotaddr)  $port";
}

# make an outgoing socket connection
sub connect_socket {
	local ($socket, $rname, $rport) = @_;
	local ($lname) = `hostname`;
	local ($lport) = 0;
	local ($name, $aliases, $type, $len, $lhost, $rhost);

	$rname = `hostname` unless $rname;
	$rport = $telnetport unless $rport;

	$rname =~ tr/\n//d;
	$lname =~ tr/\n//d;

	($name, $aliases, $type, $len, $lhost) = gethostbyname ($lname);
	if ($rname =~ /[^0-9\.]/) {
		($name, $aliases, $type, $len, $rhost) = gethostbyname ($rname);
	} else {
		$rhost = pack('C4',split(/\./,$rname));
	}

	@inetaddr = unpack('C4',$rhost);
	$dotaddr = join ('.', @inetaddr);

	print "Trying $rname ($dotaddr)  $rport\n";

	$lsock = pack ($sockaddr, &AF_INET, $lport, $lhost);
	$rsock = pack ($sockaddr, &AF_INET, $rport, $rhost);

	socket ($socket, &PF_INET, &SOCK_STREAM, $TCP) || die "socket: $!";
	bind ($socket, $lsock) || die "bind: $!";
	connect ($socket, $rsock) || die "connect: $!";

	select ($socket); $| = 1; select (STDOUT); $| = 1;

	print "Connected to ".&peer_info($socket)."\n";
}

# set up filehandle bitmask (for select)
sub fhbits {
	local ($bits);

	for (@_) { vec($bits,fileno($_),1) = 1; }
	$bits;
}

sub read_MUD {
	local ($line, $in);

	$line = "";
	$line .= $in while (read (MUD, $in, 1) && ($in ne "\n"));
	$line .= $in;
	$line =~ s/\r//go;
	print $rawecho $line if $rawecho;
	$line;
}

sub wait_for_data {
	$line = &read_MUD until $line eq "$outputprefix\n";
	$block = "";
	$line = "";
	until ($line eq "$outputsuffix\n") {
		$block .= $line;
		$line = &read_MUD;
	}
	print $blockecho $block."\n" if $blockecho;
	$block;
}

sub command_MUD {
	print MUD $_[0]."\n";
	&wait_for_data;
	$block;
}

sub connect_MUD {
	$mname = $ARGV[1];

	open (WORLDLIST, $worldlist);
	while (<WORLDLIST>) {
		if (/^$mname\s/io) {
			($mname,$pname,$passwd,$addr,$port) = split (/\s+/);
		}
	}
	close (WORLDLIST);

	&connect_socket (MUD, $addr, $port);

	print MUD "connect $pname $passwd\n";

	&read_MUD;

	sleep (5);

	print MUD "OUTPUTPREFIX $outputprefix\nOUTPUTSUFFIX $outputsuffix\n";

#	&command_MUD ("\"Installing Dynamic Space");
}

sub disconnect_MUD {
	shutdown (MUD, 2);
}

sub think {
	&command_MUD ("think ".$_[0]);
	$block;
}

sub num {
	&command_MUD ("think [num(".$_[0].")]");
	chop $block;
	$block;
}

sub tel {
	if ($_[0] !~ /^#\d+$/o) {
		die "No destination for teleport, stopped";
	}

	&command_MUD ("@tel ".$_[0]);
}

sub make {
	if ($_[0] =~ /ROOM/i) {
		if ($_[1] !~ /^.+/o) {
			die "No name for room, stopped";
		}

		&command_MUD ("@dig ".$_[1]);
		$block =~ s/[^0123456789]//go;
		$block = "#".$block;
	}
	if ($_[0] =~ /EXIT/i) {
		if ($_[1] !~ /^.+/o) {
			die "No name for exit, stopped";
		}
		if ($_[2] !~ /^#\d+$/o) {
			die "No source for exit, stopped";
		}
		if ($_[3] !~ /^#\d+$/o) {
			die "No destnation for exit, stopped";
		}

		&command_MUD ("@tel ".$_[2]);
		&command_MUD ("@open ".$_[1]."=".$_[3]);
		&command_MUD ("think [num(".
			      substr($_[1],0,index($_[1],";")).
			      ")]");
		$block =~ s/\n//go;
	}
	if ($_[0] =~ /THING/i) {
		if ($_[1] !~ /^.+/o) {
			die "No name for thing, stopped";
		}

		$_[2] = 10 if $_[2] eq "";

		&command_MUD ("@create ".$_[1]."=".$_[2]);
		$block =~ s/[^0123456789]//go;
		$lblock = "#".$block;
		&command_MUD ("drop ".$_[1]);
		$block = $lblock;
	}
	$block;
}

sub make_one {
	&command_MUD ("think [num(".
		      substr($_[1],0,index($_[1],";")).
		      ")]");
	chop $block;
	if ($block eq "I don't see that here.\n#-1") {
		&make (@_);
	}
	$block;
}

sub dest {
	if ($_[0] !~ /^#\d+$/o) {
		die "No object for dest, stopped";
	}

	&command_MUD ("@dest ".$_[0]);
}

sub nuke {
	if ($_[0] !~ /^#\d+$/o) {
		die "No object for nuke, stopped";
	}

	&command_MUD ("@nuke ".$_[0]);
}

sub attr {
	if ($_[0] !~ /^.+/o) {
		die "No object for attr, stopped";
	}
	if ($_[1] !~ /^.+/o) {
		die "No name for attr, stopped";
	}
	if ($_[2] !~ /^.+/o) {
		die "No body for attr, stopped";
	}

	$_[2] =~ s/\n//go;
	&command_MUD ("&".$_[1]." ".$_[0]."=".$_[2]);
}

sub edit {
	if ($_[0] !~ /^.+/o) {
		die "No object for edit, stopped";
	}
	if ($_[1] !~ /^.+/o) {
		die "No name for edit, stopped";
	}
	if ($_[2] !~ /^.+/o) {
		die "No search for edit, stopped";
	}
	if ($_[3] !~ /^.+/o) {
		die "No replace for edit, stopped";
	}

	$_[2] =~ s/\n//go;
	$_[3] =~ s/\n//go;
	&command_MUD ("@edit ".$_[0]."/".$_[1]."=".$_[2].",".$_[3]);
}

sub flag {
	if ($_[0] !~ /^.+/o) {
		die "No object for flag, stopped";
	}
	if ($_[1] !~ /^.+/o) {
		die "No name for flag, stopped";
	}

	&command_MUD ("@set ".$_[0]."=".$_[1]);
}

sub link {
	if ($_[0] !~ /^.+/o) {
		die "No object for link, stopped";
	}
	if ($_[1] !~ /^.+/o) {
		die "No destination for link, stopped";
	}

	&command_MUD ("@link ".$_[0]."=".$_[1]);
}

sub unlink {
	if ($_[0] !~ /^.+/o) {
		die "No object for unlink, stopped";
	}

	&command_MUD ("@unlink ".$_[0]);
}

sub lock {
	if ($_[0] !~ /^.+/o) {
		die "No object for lock, stopped";
	}
	if ($_[2] !~ /^.+/o) {
		die "No body for lock, stopped";
	}

	&command_MUD ("@lock".$_[1]." ".$_[0]."=".$_[2]);
}

sub parent {
	if ($_[0] !~ /^.+/o) {
		die "No object for parent, stopped";
	}
	if ($_[1] !~ /^.+/o) {
		die "No master for parent, stopped";
	}

	&command_MUD ("@parent ".$_[0]."=".$_[1]);
}

sub zone {
	if ($_[0] !~ /^.+/o) {
		die "No object for zone, stopped";
	}
	if ($_[1] !~ /^.+/o) {
		die "No master for zone, stopped";
	}

	&command_MUD ("@chzone ".$_[0]."=".$_[1]);
}

if ($#ARGV < 1) {
	die "
Syntax: $0 script mushname

script is the sorce to assemble.
mushname is the name of the MUSH to assemble on.
";
}

&connect_MUD;

require $ARGV[0];

&disconnect_MUD;