Article 3464 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:3464
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!mp.cs.niu.edu!ux1.cso.uiuc.edu!howland.reston.ans.net!noc.near.net!uunet!mcsun!uknet!warwick!news.dcs.warwick.ac.uk!mrccrc!daresbury!keele!nott-cs!news
From: arf@maths.nott.ac.uk (Anthony Iano-Fletcher)
Subject: Re: Perl interface to Websters on-line dictionary?
Message-ID: <1993Jun15.101731.8124@cs.nott.ac.uk>
Sender: news@cs.nott.ac.uk
Organization: Maths Dept., Nottingham University, UK.
Date: Tue, 15 Jun 93 10:17:31 GMT
Lines: 2286


It seems my previous offering got mangled somewhere along the line
(Honest I did check the shar file before posting!). Here is another
attempt at posting my Webster perl client. Sorry to those that tried it
and couldnt unpack it.

------------------------------- cut here ------------------------
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  webster-1.0 webster-1.0/webster.p webster-1.0/Makefile
#   webster-1.0/help-info webster-1.0/README webster-1.0/location.ph
#   webster-1.0/lib webster-1.0/lib/command.pl
#   webster-1.0/lib/telnet.pl webster-1.0/lib/debug.pl
#   webster-1.0/lib/chardef.pl webster-1.0/webster
# Wrapped by arf@guinness on Tue Jun 15 10:48:39 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test ! -d webster-1.0 ; then
    echo shar: Creating directory \"webster-1.0\"
    mkdir webster-1.0
fi
if test -f webster-1.0/webster.p -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/webster.p\"
else
echo shar: Extracting \"webster-1.0/webster.p\" \(6800 characters\)
sed "s/^X//" >webster-1.0/webster.p <<'END_OF_webster-1.0/webster.p'
X#! /usr/local/bin/perl
X'di';
X'ig00';
X
X#
X# This code is freely available to whoever wants it. It can be   
X# distributed to anyone, and can be modified. The author takes   
X# no responsibilty for any errors in or caused by this code.     
X#  
X# Please retain my name and that of the Nottingham University       
X# Mathematics Department on any bits taken from this code. We 
X# reserve the copyright on this work. 
X#
X#			 Anthony Iano-Fletcher           
X#			 arf@maths.warwick.ac.uk         
X
X
X# Deal with builtin defaults.
X$LIBDIR		= "lib" unless $LIBDIR;
X$PERL		= "/usr/local/bin/perl" unless $PERL;
X$WEBSTERHOST	= "cs.indiana.edu" unless $WEBSTERHOST;
X$VERSION	= "developmental" unless $VERSION;
X
Xunshift (@INC, $LIBDIR);
X
X# Requires.
Xrequire 'telnet.pl';
Xrequire 'debug.pl';
Xrequire 'command.pl';
X
X# defaults.
X$program= $0;
X$program=~ s/.*\///;
X
X# Usage.
X$usage	= "Usage:\t$program -usage
X\t$program -version
X\t$program [-h <host>] [-s] [-d] <words>\n";
X
X$version = "Version $VERSION\n";
X
X# override WEBSTERHOST.
X$WEBSTERHOST = $ENV{WEBSTERHOST} if defined($ENV{WEBSTERHOST});
X
X# defaults
X@ports	= (2627, 103);
X$mode	= "DEFINE";
X$EOFCH	= sprintf("\200");
X@list	= ();
X
X# Process the command line.
Xwhile (@ARGV)
X{
X	$_ = shift(@ARGV);
X
X	if (s/^-//)
X	{
X		if (/^-$/)		{ last; }
X		elsif (/^h$/)		{ $WEBSTERHOST = shift; }
X		elsif (/^p$/)		{ unshift (@port, shift); }
X		elsif (/^d$/)		{ $mode = "DEFINE"; }
X		elsif (/^s$/)		{ $mode = "SPELL"; }
X		elsif (/^debug$/)	{ &debug'set(shift); }
X		elsif (/^version$/)	{ warn $version; exit 0; }
X		elsif (/^usage$/)	{ warn $usage; exit 0; }
X		else
X		{
X			warn "$program: unknown flag -$_\n";
X			die $usage;
X		}
X	}
X	else
X	{
X		unshift(@ARGV, $_);
X		last;
X	}
X}
X
X
X# connect to host.
X&Telnet'open(WEB, $WEBSTERHOST, @ports)
X		|| die "Can't connect to $WEBSTERHOST ($!).\n";
X
X# no buffering please.
X$|	= 1;
Xselect ((select(WEB), $| = 1)[$[]);
Xselect ((select(STDERR), $| = 1)[$[]);
X
X# Binary mode.
Xbinmode(WEB);
X
X# deal with command lines words.
Xif (@ARGV)
X{
X	for $word (@ARGV)
X	{
X		&send ("$mode $word");
X		&read;
X		print "\n";
X	}
X
X	exit;
X}
X
X# deal with interactive mode.
X#while (print STDERR "$mode: ", $word = <>)
X$Command'prompt = "$mode: ";
Xwhile ($word = &Command'get())
X{
X	next if ($word =~ /^\s+$/);	# ignore blank lines.
X
X	chop($word);
X
X	if ($word =~ /^\d+$/)
X	{
X		unless ($list[$word])
X		{
X			print "Word number $word not in list!\n";
X			next;
X		}
X		$word = $list[$word]
X	}
X
X	&send ("$mode $word");	
X	&read;
X	print "\n";
X}
X
Xexit;
X
X##### functions.
Xsub send 
X{
X	#print "send: @_\n";
X	print WEB "@_\r\n";
X}
X
Xsub read
X{
X	local ($w, $list, $_);
X
X	$_ = <WEB>; 
X
X	if (/^\s+$/)		{} # ignore blanks.
X	# Everything starting with ERROR is one.
X	elsif (/^ERROR\s+/)
X	{
X		warn $_;
X		return;
X	}
X	# DEFINITION <n> gives the number of x-refs, which follow.
X	elsif	(/^DEFINITION\s+(\d+)\s*/)
X	{
X		if ($1 > 0)
X		{
X			local ($no) = $1;
X			print "$no cross-references to $word:\n";
X			while ($no-- > 0)
X			{
X				$_ = <WEB>;
X				print;
X
X				# add to list.
X				s/[\r\n]*$//;
X				s/^(\d+)\s+//;
X				$list [$1] = $_;
X			}
X			print "\n";
X		}
X
X		print "$word:\n"; 
X	}
X	# SPELLING <n> gives the number of word matches
X	# 	n = 0 means incorrect spelling.
X	#	n = 1 means exactly right.
X	#	n > 1 means can find <n> matches to this pattern.
X	elsif	(/^SPELLING\s+0\s*/)
X	{
X		print "Unknown word $word.\n";
X		return;
X	}
X	elsif	(/^SPELLING\s+1\s*/)
X	{
X		print "Correct spelling: $word\n";
X		return;
X	}
X	elsif	(/^SPELLING\s+(\d+)\s*/)
X	{
X		print "Incorrect spelling for $word; $1 possibilities.\n";
X	}
X	elsif (/^SPELLING\s*$/) 
X	{
X		print "Here is a list of alternatives for $word:\n";
X		$list = 1;
X	}
X	# WILD 0 gives a negative responce to a pattern match.
X	# WILD gives a list of pattern matches.
X	elsif (/^WILD\s+0\s*$/) 
X	{
X		print "There no matches to $word:\n";
X		return;
X	}
X	elsif (/^WILD\s*$/) 
X	{
X		print "There are a number of matches to $word:\n";
X		$list = 1;
X	}
X	# Everything else is an error.
X	else
X	{
X		print "huh?: $_";
X		return;
X	}
X
X	# grab all the next info, ends with a $EOFCH.
X	local ($/) = $EOFCH;
X	$_ = <WEB>;
X	chop;
X	print;
X
X	# bodge!!!! yuk. Or else you lose the 1
X	# at the beginning of the list.
X	$_ = "R \n$_";	# RABBITS
X
X	# remember the list if there is one.
X	if ($list)
X	{
X		for $w (split(/\n/, $_))
X		{
X			next unless s/^\s*(\d+)\s+//;
X			$w =~ s/[\r\n]*$//;
X			$list[$1] = $w;
X		}
X	}
X
X}
X
X
X###############################################################
X
X	# These next few lines are legal in both Perl and nroff.
X
X.00;			# finish .ig
X
X'di			\" finish diversion--previous line must be blank
X.nr nl 0-1		\" fake up transition to first page again
X.nr % 0			\" start at page 1
X'; __END__ ##### From here on it's a standard manual page #####
X
X.TH WEBSTER 1 "March 9, 1993"
X.AT 3
X.SH NAME
Xwebster \- Webster dictionary. 
X.SH SYNOPSIS
X.B webster
X.RI [ -h <host> ]
X.RI [ -p <port> ]
X.RI [ -s ]
X.RI [ -d ]
X<words>
X.br
X.B webster
X.RI -usage
X.br
X.B webster
X.RI -version
X.SH DESCRIPTION
X.B Webster
Xconnects to a Webster dictionary server
Xand returns the spellings and/or definitions of the
Xspecified words.
X.LP
XIf there are words specified on the command line
Xthen
X.I webster
Xacts on those words and quits.
XOtherwise, it enters into interactive mode
X(which has some line editting features).
X.LP
XThere are two modes 
X(which can be set via the -d and -s flags):
X.TP
XDEFINE
XThis causes the server to return the definition of the specified words
X(this is the default).
X.TP
XSPELL
XThis causes the server to comment of the accuracy of the spelling.
XThe built-in default server is 
X.I cs.inidiana.edu.
X.SH OPTIONS
X.TP
X.I -usage
XThis gives a brief usage message and quits.
X.TP
X.I -version
XThis gives the version number and quits.
X.TP
X.I -h <host>
XThis sets the Webster disctionary host to connect to.
XThis overrides both the environment variable WEBSTERHOST
Xand the builtin default.
X.TP
X.I -p <port>
XThis sets the port of first choice.
XThe default is 2627.
X.TP
X.I -d
XThis sets the mode to be DEFINE (the default).
X.TP
X.I -s
XThis sets the mode to be SPELL.
X.SH ENVIRONMENT
XThe environment variable WEBSTERHOST
Xoverrides the builtin default.
X.SH "SEE ALSO"
Xperl (1).
X.SH AUTHOR
X." Anthony Iano-Fletcher <arf@maths.nott.ac.uk>
X.nf
XAnthony R Iano-Fletcher,
XDepartment of Mathematics,
XUniversity of Nottingham,
XNottingham, UK
Xarf@maths.nott.ac.uk
X.fi
X.SH COPYRIGHT
XThis code is freely available to whoever wants it. It can be   
Xdistributed to anyone, and can be modified. The author takes   
Xno responsibilty for any errors in or caused by this code.     
X 
XPlease retain my name and that of the Nottingham University       
XMathematics Department on any bits taken from this code. We 
Xreserve the copyright on this work. 
X.SH THANKS TO
XDavid A. Curry, who wrote an original client in C for BSD like machines,
Xwithout a manual page.
X.ex Anything after this line will be ignored by nroff.
END_OF_webster-1.0/webster.p
if test 6800 -ne `wc -c <webster-1.0/webster.p`; then
    echo shar: \"webster-1.0/webster.p\" unpacked with wrong size!
fi
chmod +x webster-1.0/webster.p
# end of overwriting check
fi
if test -f webster-1.0/Makefile -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/Makefile\"
else
echo shar: Extracting \"webster-1.0/Makefile\" \(2211 characters\)
sed "s/^X//" >webster-1.0/Makefile <<'END_OF_webster-1.0/Makefile'
X# This code is freely available to whoever wants it. It can be   
X# distributed to anyone, and can be modified. The author takes   
X# no responsibilty for any errors in or caused by this code.     
X#  
X# Please retain my name and that of the Nottingham University       
X# Mathematics Department on any bits taken from this code. We 
X# reserve the copyright on this work. 
X#
X#			 Anthony Iano-Fletcher           
X#			 arf@maths.warwick.ac.uk         
X
X#
X# Makefile. A.R. Iano-Fletcher.
X#
X# To install these scripts
X#	make install clean
X# after changing the lines below to your preference.
X#
X
X# -----------   Required to change the following. ---------------- #
XTOP		= $(HOME)
XTOP		= /usr/local
X
XLIBDIR		= $(TOP)/lib/webster
XMANDIR		= $(TOP)/man
XBIN		= $(TOP)/bin
XWEBSTERHOST	= 129.79.254.191	# IP for cs.indiana.edu
XPERL		= /usr/local/bin/perl
XVERSION		= "1.0";
X# ---------------------------------------------------------------- #
X
X#
X# You dont need to touch the lines below this.
X#
X
X# All the programs in this directory are their own manuals.
X# To add a new script, add its name to the list PROGS.
XPROGS	= webster
X
X#
X# You DEFINITELY dont need to touch the lines below this.
X#
X
X# The names of the manual pages for these scripts.
XMANFILES	= webster.1
X
Xall: $(PROGS)
X
Xlocation.ph: Makefile
X	$(RM) $@
X	echo "#! $(PERL)" >> $@
X	echo \'di\'\; >> $@
X	echo \'ig00\'\; >> $@
X	echo "\$$LIBDIR		= '$(LIBDIR)';" >> $@
X	echo "\$$WEBSTERHOST	= '$(WEBSTERHOST)';" >> $@
X	echo "\$$VERSION	= '$(VERSION)';" >> $@
X
X%: %.p location.ph
X	# ------------------- $@ ------------------- 
X	cat location.ph $@.p > $@
X	chmod a+x $@
X
X%.1: %.p 
X	-/bin/ln -s $*.p $@
X
Xinstall: $(PROGS)
X	# ------------ installing --------------
X	/bin/cp $(PROGS) $(BIN)
X	/bin/rm -rf $(LIBDIR)
X	/bin/cp -r lib $(LIBDIR)
X
Xinstall.man: $(MANFILES)
X	# ------------ installing --------------
X	/bin/cp $(MANFILES) $(MANDIR)/man1
X
Xinfo:
X	# Defaults used to make the scripts.
X	# perl binary:			$(PERL)
X	# directory of libraries:	$(LIBDIR)
X	# directory for manuals:	$(MANDIR)
X	# directory for scripts:	$(BIN)
X	# host for webster:		$(WEBSTERHOST)
X
Xclean:
X	# ------------ clean --------------
X	/bin/rm -f $(PROGS)
X	/bin/rm -f $(MANFILES)
X	/bin/rm -f core location.ph
X
END_OF_webster-1.0/Makefile
if test 2211 -ne `wc -c <webster-1.0/Makefile`; then
    echo shar: \"webster-1.0/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f webster-1.0/help-info -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/help-info\"
else
echo shar: Extracting \"webster-1.0/help-info\" \(5209 characters\)
sed "s/^X//" >webster-1.0/help-info <<'END_OF_webster-1.0/help-info'
XTrying 129.79.254.191 ...
XConnected to cs.indiana.edu.
XEscape character is '^]'.
XDICTIONARY server protocol:
X
XContact name is "DICTIONARY".  A full connectional is established
X(additional data in the RFC is ignored, there's no simple mode)
X
XCommand lines to the server are of the form
X
X	COMMAND[<space>ARGUMENT]<NL>
X
Xwhere the part in brackets, [], is optional.  <space> is ASCII space,
Xoctal 40, and <NL> for Chaosnet is the LispMachine NewLine character,
Xoctal 215, and for Internet it's CRLF, octal 15 then octal 12.
X
XThe server responds with a single line of the same format, and then if
Xthere's additional data it comes next, followed by an EOF packet.
X
XThe actual response will be either
X
X	ERROR<space>RECOVERABLE<error message><NL>
Xor	ERROR<space>FATAL<error message><NL>
X
Xor a command-depenedent response.  FATAL-type errors are just that,
Xfatal, and the server will go away after sending the ERROR message.
X
XCommand:	HELP<NL>
X
XThis command will send back the text of this document, the dictionary
Xprotocol, followed by <EOF>.
X
XCommand:	DEFINE<space>word<NL>
X
XThis is the command that asks for the defintion of a word from the
Xdictionary.  The possible response are:
X
X	WILD<space>0<NL>
X
Xor
X	WILD<NL>
X	<word#><space><word1><NL>
X	<word#><space><word2><NL>
X		. . .
X	<word#><space><wordN><NL>
X	<EOF>
X
XA WILD response is given when the word to be defined contained
Xwildcard characters ('%' which matches exactly one character, or '*'
Xwhich matches 0 or more characters).  If the wild string had no
Xmatches, a WILD response with argument 0 is returned.  If there are
Xone or more matches, a WILD with no arg is returned, and then the
Xmatching words are sent, one per line, followed by an EOF packet.  For
Xeach returned word there is a word#, a string of ASCII digits
Xrepresenting a decimal number.  For user convenience, that word#
Xmay be specified in place of the word itself, in a DEFINE request.
X
X	SPELLING<space>0<NL>
X
Xor
X	SPELLING<NL>
X	{ same response as WILD }
X
XWhen a word is specified that couldn't be found verbatim, Webster
Xattempts to Do What You Mean, and try to fix common typos (transposed
Xletter, one missing or one additional letter, or one letter wrong).
XIf any such matches are found, a SPELL response is returned, listing
Xall the "possible" words.  If no such words were found, (e.g. it
Xcouldn't make ANY sense out of the input word), a SPELL with argument
X0 is returned.
X
X	DEFINITION<space>n<NL>
Xthen n	{ WILD-response-like lines }
Xthen	<any amount of ASCII text>
X	<EOF>
X
XA DEFINITION response means the word matched an entry, and the definition
Xfollows.  The argument (always present), n,  is the # of cross-references
Xin the definition that might prove interesting.  If n > 0, then follows
Xone line per cross-reference, in the same fork as the WILD responses.  Then
Xcomes the body of the definition, followed by and <EOF>
X
XCommand:	COMPLETE<space>word<NL>
X
XIs used to simulate is action of the TENEX/TWENEX <escape> completion
Xfeature.  "word" is usually the beginning portion of a word that is
Xexpected to be unique.  The response is either
X	AMBIGUOUS<space>n<NL>
X
Xor
X	COMPLETION<space>full-word<NL>
X
XIf the partial word you specified matches zero or more than one
Xdictionary entry, an AMBIGUOUS response is given, the argument
Xbeing the number of matches.
X
XIf the partial word matches one and only one entry, a COMPLETION
Xreply is sent back, containing the full text of the word that was
Xcompleted.  Note that COMPLETION and wildcard characters CAN be
Xmixed, so the user program should check the word being completed,
Xand if any wildcard characters exist (in the supplied part),
Xthe entire word should be retyped, not just what was competed.
X
XCommand:	ENDINGS<space>word<NL>
X
XThis command is used to simulate the "?" TENEX/TWENEX feature.
XThe response is either
X
X	MATCHS<space>0<NL>
X
Xor
X	MATCHS<NL>
X	{ WILD-like word-list }
X
XWhat ENDINGS actually does is append a "*" to the word you gave and
Xcheck for WILD matches.  If there were none, you get the ENDINGS with
Xargument 0 response, else a WILD-like list of words.  NOTE that even
Xtho the word-line returned have a word#, that number does not work
Xthe same as for WILD or SPELLING.  A number is present on the line so
Xthat the response is in the same format as that of WILD or SPELLING,
Xto make it a little easier on the user program.  Those number shouldn't
Xbe passed back as they don't mean anything.
X
XCommand:	SPELL<space>word<NL>
X
XThe SPELL command is for people who want to (ab)use the dictionary
Xserver as a SPELL server.  The word is looked up, and if it matches
Xzero or one entries you get a
X
X	SPELLING<space>matches<NL>
X
Xresponse where matches is 0 or 1.
X
XIf the word isn't found, but has possible alternate spellings, those
Xare returned exactly like a SPELLING response to DEFINE.
XDEFINITION 0
X1. rab.bit \'rab-*t\ \-e-\ n or rabbit or rabbits [ME rabet] pl  often 
X   attrib  1a: a small long-eared mammal (Oryctolagus cuniculus) of the hare 
X   family that differs from ordinary hares in producing naked young and in its 
X   burrowing habits 1b: HARE 2: the pelt of a rabbit 3: WELSH RABBIT - 
X   rab.bity aj
X2. rabbit vi : to hunt rabbits - rab.bit.er n
XERROR RECOVERABLEUnknown command: EXIT
Xtelnet> Connection closed.
END_OF_webster-1.0/help-info
if test 5209 -ne `wc -c <webster-1.0/help-info`; then
    echo shar: \"webster-1.0/help-info\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f webster-1.0/README -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/README\"
else
echo shar: Extracting \"webster-1.0/README\" \(919 characters\)
sed "s/^X//" >webster-1.0/README <<'END_OF_webster-1.0/README'
X		---- webster ----
X
XDESCRIPTION:
X	This is a Webster client implemented in Perl. It allows
X	both a one-off interrogation of the webster database
X	or an interactive session.
X
XINSTALLATION:
X	Edit the first few lines of the Makefile and type
X
X		make install install.man clean
X
X	Each stage can be done separately.
X
XMANUAL:
X	The perl script is its own manual page. Read it using:
X
X		nroff -man webster.p | less
X
XCOPYRIGHT:
X	This code is freely available to whoever wants it. It can be   
X	distributed to anyone, and can be modified. The author takes   
X	no responsibilty for any errors in or caused by this code.     
X 
X	Please retain my name and that of the Nottingham University 
X	Mathematics Department on any bits taken from this code. We 
X	reserve the copyright on this work. 
X
XAUTHOR:
X	Anthony Iano-Fletcher,
X	Department of Mathematics,
X	University of Nottingham,
X	Nottingham, UK.
X	arf@maths.warwick.ac.uk         
X
X
X
END_OF_webster-1.0/README
if test 919 -ne `wc -c <webster-1.0/README`; then
    echo shar: \"webster-1.0/README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f webster-1.0/location.ph -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/location.ph\"
else
echo shar: Extracting \"webster-1.0/location.ph\" \(126 characters\)
sed "s/^X//" >webster-1.0/location.ph <<'END_OF_webster-1.0/location.ph'
X#! /usr/local/bin/perl
X'di';
X'ig00';
X$LIBDIR		= '/usr/local/lib/webster';
X$WEBSTERHOST	= '129.79.254.191';
X$VERSION	= '1.0;';
END_OF_webster-1.0/location.ph
if test 126 -ne `wc -c <webster-1.0/location.ph`; then
    echo shar: \"webster-1.0/location.ph\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d webster-1.0/lib ; then
    echo shar: Creating directory \"webster-1.0/lib\"
    mkdir webster-1.0/lib
fi
if test -f webster-1.0/lib/command.pl -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/lib/command.pl\"
else
echo shar: Extracting \"webster-1.0/lib/command.pl\" \(15769 characters\)
sed "s/^X//" >webster-1.0/lib/command.pl <<'END_OF_webster-1.0/lib/command.pl'
X
X;# 								
X;#  This code is freely available to however wants it. It can be	
X;#  distributed to anyone, and can be modified. The author takes	
X;#  no responsibilty for any errors in or caused by this code.	
X;# 								
X;#  Please retain my name and that of the Warwick University	
X;#  Geometry Group on any bits taken from this code. We reserve	
X;#  the copyright on this work.					
X;# 								
X;# 				Anthony Iano-Fletcher 		
X;# 				arf@maths.warwick.ac.uk		
X;# 								
X
X
Xpackage Command;
X
X#
X# The following is a library to do command line editing
X# similar to that of "wash", "zsh", etc. It also does ~user expansions.
X#
X# I am thankful to Wayne Thompson's complete.pl library. It has a
X# little similarity in the complete section of this code.
X#
X#			A.R. Iano-Fletcher.
X
X# Note:
X# It the characters "fun" are typed at the first prompt a "Bad free"
X# error is generatied by perl. Also by the string "$MA". These occur
X# in the add function.
X
Xrequire "chardef.pl";		# Get the characher definitions.
X
X# The initial configuration.
XCONFIGURATION:
X{
X
X	$prompt	= "+ ";		# the prompt.
X	$left	= "";
X	$right	= "";
X	$gone	= "";
X
X	$quiet	= 0;		# ring the bell on err.
X	$echo	= 0;		# no echo.
X	$debug	= undef;	# no debugging.
X	#$debug	= STDOUT;	# debugging.
X
X	$last_line_len	= 0;	# length of last line printed.
X	@command	= ();	# previous commands.
X	$cmdnumber	= 0;
X
X	# immediate flush on output.
X	select((select(STDOUT), $| = 1)[$[]);
X	select((select(STDERR), $| = 1)[$[]);
X
X	# The default bindings.
X	%ibindings =	(
X		"^M",	"newline",
X		"^P",	"previous_command",
X		"^N",	"next_command",
X		"^F",	"forward_character",
X		"^B",	"backward_character",
X		"^T",	"transpose_chars",
X		"^D",	"delete_char_forward",
X		"^W",	"delete_word_backward",
X		"^]",	"complete",
X		"^[",	"meta-prefix",
X		"^A",	"start_of_line",
X		"^E",	"end_of_line",
X		"^V",	"real_char",
X		"^X",	"kill_line",
X		"^K",	"kill_to_end_of_line",
X		"^O",	"kill_to_start_of_line",
X		"^R",	"retype_line",
X		"^D",	"stop",
X		"^G",	"bell",
X		"^U",	"undelete",
X		"242",	"undelete",	# decimal "left-s" (on sun3).
X		"DEL",	"erase",	# DEL.
X		"\010",	"erase",
X		"244",	"capitalise",	# decimal "left-t" (on sun3).
X		"248",	"extract",	# decimal "left-x" (on sun3).
X	);
X
X	%ESCfunction	= ();
X
X	&set_bind();
X}
X
X# This actually does the command line editing.
X# The arguments are:
X#	the file handle to use (if none, the STDIN is used).
X#
X# This function returns the command line.
X#
Xsub get
X{
X	local($read, $default)		= @_;
X	$read	= "STDIN"	unless $read;
X
X	$command[++$cmdnumber]	= "";
X	local($cmd)		= $cmdnumber;
X	print $debug "get command....\n";
X	print $debug "cmd = $cmd\n";
X
X	# Initialise the line.
X	$left = $default;
X	$right = "";
X
X	local($c);		# The input character.
X
X	system 'stty raw -echo';		# terminal control.
X
X	&pline();
X
X	local ($action);
X	while (($c = getc($read)) ne "") 
X	{
X		last if $bindings{$c} eq "newline";
X
X		#print $debug ord($c) . "\r\n";
X		print "$c" if $echo;
X
X		$action = $bindings{$c};
X		if ($action)
X			{ eval ("&$action()") || die "$@ (action = $action)"; }
X		else
X			{ &add($c); }
X	}
X
X	system 'stty -raw echo';	# restore terminal.
X	
X	$return = $left . $right;
X	$command[$cmdnumber] = $return;
X	
X	print "\n";
X
X	#local(@return) = <${return}>;
X	#$return = join(" ", @return);
X
X	$return .= "\n";
X}
X
X# Sorts out a string to see if its an inbuilt command or not.
X# If it is it does the command.
X# Returns true if successful, false otherwise.
Xsub inbuilt
X{
X	local ($_) = @_;
X
X	if (s/^\s*bind\s+//)		{ &bind($_); }
X	elsif (s/^\s*unbind\s+//)	{ &unbind(split("\s+", $_)); }
X	elsif (s/^\s*function\s+//)	{ &function($_); }
X	elsif (s/^\s*history\s*$//)	{ &history(); }
X	else
X		{ return undef; }
X
X	1;
X}
X
X# Adds the specified character to the command line at the cursor.
Xsub add
X{
X	local ($ch) = @_;
X	$left .= $ch;
X	&pline();
X}
X
X# This capitalises the character under the cursor, and moves on.
Xsub capitalise
X{
X	if ($right =~ s/^.//)
X	{
X		local ($c) = $&;
X		$c =~ tr/a-zA-Z/A-Za-z/;
X		$left .= $c;
X		&pline();
X	}
X	else	{ &bell(); }
X}
X
X# Reprints the line on the next line.
Xsub retype_line
X{
X	print "\n";
X	&pline();
X}
X
X# Moves the cursor back 1 character.
Xsub backward_character
X{
X	#print $debug "backward\n";
X	if ($left =~ s/.$//)	{ $right = "$&$right"; }
X	else			{ &bell(); }
X	&pline();
X}
X
X# Moves the cursor forward 1 character.
Xsub forward_character
X{
X	#print $debug "forward\n";
X	if ($right =~ s/^.//)	{ $left .= $&; }
X	else			{ &bell(); }
X	&pline();
X}
X
X# Moves the cursor to the start of the line.
Xsub start_of_line
X{
X	$right = "$left$right";
X	$left = "";
X	&pline();
X}
X
X# Moves the cursor to the end of the line.
Xsub end_of_line
X{
X	$left .= $right;
X	$right = "";
X	&pline();
X}
X
X# Swaps the character under the cursor with the preceeding one.
Xsub transpose_chars
X{
X	if ($left =~ s/(.)(.)$//)
X	{
X		$left .= "$2$1";
X	}
X	else { &bell(); }
X	&pline();
X}
X
X# Deletes the next word.
Xsub delete_word_forward
X{
X	if ($right =~ s/^(\S*)//)
X	{
X		$gone = $1;
X	}
X	else { &bell(); }
X	&pline();
X}
X
X# deletes the last word.
Xsub delete_word_backward
X{
X	if ($left =~ s/(\S*)$//)
X	{
X		$gone = $1;
X	}
X	else { &bell(); }
X	&pline();
X}
X
X# Moves forward a word.
Xsub forward_word
X{
X	if ($right =~ s/^(\S*\s*)//)
X	{
X		$left .= $&;
X		&pline();
X	}
X	else
X		{ &bell(); }
X}
X
X# Move back a word.
Xsub backward_word
X{
X	if ($left =~ s/(\S*\s*)$//)
X	{
X		$right = $& . $right;
X		&pline();
X	}
X	else { &bell(); }
X}
X
X# Changes line to be the last command which matches the beginning
X# of the current line.
Xsub previous_command
X{
X	#print $debug "previous command.\n";
X	while (--$cmd > 0) 
X	{
X		# print $debug "Compare $left to $command[$cmd].\n";
X		local ($Left) = $left;
X		$Left =~ s/\W/\\$&/g;
X		if ($command[$cmd] =~ /^$Left(.*)/)
X		{
X			$right = $1;
X			&pline();
X			last;
X		}
X	}
X
X	# ring bell if no success.
X	&bell() if ($cmd <= 1);
X	1;
X}
X
X# Changes line to be the next command which matches the beginning
X# of the current line.
Xsub next_command
X{
X	#print $debug "next command.\n";
X	while ($cmd++ < $cmdnumber) 
X	{
X		#print $debug "Compare $left to $command[$cmd].\n";
X		local ($Left) = $left;
X		$Left =~ s/\W/\\$&/g;
X		if ($command[$cmd] =~ /^$Left(.*)/)
X		{
X			$right = $1;
X			&pline();
X			last;
X		}
X	}
X
X	# ring bell if no success.
X	&bell() if ($cmd >= $cmdnumber) ;
X	1;
X}
X
X# Empties the line.
Xsub kill_line
X{	
X	$gone = $left . $right;
X	$left = "";
X	$right = "";
X	&pline();
X}
X
X# Removes the end of the line from the cursor.
Xsub kill_to_end_of_line
X{	
X	if ($right)
X	{
X		$gone = $right;
X		$right = "";
X		&pline();
X	}
X	else { &bell(); }
X}
X
X# Removes the beginning of the line from the cursor.
Xsub kill_to_start_of_line
X{	
X	if ($left)
X	{
X		$gone = $left;
X		$left = "";
X		&pline();
X	}
X	else { &bell(); }
X}
X
X# Erases the character before the cursor.
Xsub erase
X{
X	# (DEL) || (BS) erase
X	if ($left) 
X	{
X		$gone = chop ($left);
X		&pline(" ");
X	}
X	else { &bell(); }
X}
X
X# Deletes the character under the cursor.
Xsub delete_char_forward
X{
X	if ($right =~ s/^.//)	{ $gone = $1; &pline(" "); }
X	else			{ &bell(); }
X}
X
X# Lists the possible files names which start with this line.
Xsub list
X{
X	print "\n\r";			# to indicate that its
X					# thinking.
X	local(@match) = &listing();	# Think.
X	print "@match\n";		# print.
X	&pline();
X
X}
X
X# Signify that the next character specifies a pseudo-function to use.
Xsub meta_prefix
X{
X	# expand the ESC functions.
X	$right = "@" . $right;
X	&pline();
X
X	$c = getc($read);
X	$right =~ s/^.//;
X	local ($func) = $ESCfunction{$c};
X	if ($func)
X		{ $left .= $func; }
X	else
X		{ &bell(); }
X	&pline();
X}
X
X# End of text - closes the input. Does not work at present.
Xsub eot
X{
X	# This closes the input.
X
X	# restore terminal.
X	system 'stty -raw echo';
X	print STDERR "\n";
X}
X
X# Completes the file name.
Xsub complete
X{
X	local(@match) = &listing();
X	print $debug "match = (@match)\n";
X	if (@match)
X	{
X		#print "\r\n";	# Its thinking.
X		local($common) = pop(@match);	
X		print $debug "common = $common\n";
X		local($origl) = length $common;
X		local($l) = length $common;
X		foreach (@match)
X		{
X			$l-- until ((substr ($common, 0, $l) eq substr ($_, 0, $l)));
X			$common = substr ($common, 0, $l);
X		}
X		print $debug "common = $common\n";
X		&bell()	if ($origl != $l);
X		$left =~ s/([^\/\s]*)$/$common/;
X		&pline();
X	}
X	else	{ &bell(); }
X}
X
X# Ring the bell.
Xsub bell
X{
X	if ($quiet)	{ print "^G"; }
X	else		{ print "\007"; }
X	1;
X}
X
X# This expands a given variable from the environment or globs.
Xsub extract
X{
X	print $debug "extraction\n";
X	if ($left =~ s/\$(\w+)$//)
X	{
X		local($word) = $1;
X		local($replace) = $ENV{$word};
X		print $debug "\$$word -- $replace\n";
X		if ($replace)	{ $left .= $replace; }
X		else		{ $left .= "\$$word"; &bell(); }
X
X		&pline();
X	}
X	elsif ($left =~ s/(\~[^\~]*)$//)
X	{
X		local ($word) = $1;
X		local (@replace) = <${word}>;
X		print $debug "\r\n$word -- @replace\n";
X
X		local ($replace) = pop (@replace);
X		if (!@replace)
X		{
X			if ($replace)	{ $left .= $replace; }
X			else		{ $left .= "$word"; &bell(); }
X		}
X		else
X		{
X			$left .= "$word";
X			&bell();
X			warn "\n\rtoo many matches.\n";
X		}
X
X		&pline();
X	}
X	else		{ &bell(); }
X}
X
X# This takes the last part of the $left
X# looks for the files that start with that string.
X# If that string has a path name then use that
X# esle if it is a word at the beginning of the line
X# use the $PATH of the environment to find such words
X# or else just look in the local directory.
Xsub listing
X{
X	#print $debug "\"list\" \n";
X
X	$left =~ /(\S*)$/;
X	local($file) = $1;
X	#print $debug "\"list $file\" \n";
X	local($dir, @match);
X
X	if ($file =~ m|^(.*)/(.*)$|)
X	{
X		$dir = $1;
X		$file = $2;
X
X		# sort out the globbing on $dir.
X		local (@dir) = <${dir}>;
X		$dir = pop (@dir);
X		if (@dir)
X		{
X			warn "\n\rtoo many directories matching $file.\n";
X		}
X	}
X
X	#print $debug "dir=$dir file=$file\n";
X	$file =~ s/(\W)/\\\1/g;	# Protect the string for matching.
X
X	if ($dir)
X	{
X		# then we know where to look.
X		@match = &look($dir, $file);
X	}
X	else
X	{
X		if ($left =~ /^\s*\S*$/)
X		{
X			# Then its a command.
X			@path = split(/:/, $ENV{PATH});
X			foreach (@path)
X			{
X				local ($found) = &look($_, $file, "-x");
X				push(@match, $found) if $found;
X			}
X		}
X		else
X		{
X			# local file.
X			@match = &look("", $file);
X		}
X	}
X
X	@match;
X}
X
X# This takes 3 arguments; a directory to look in,
X# the first part of a file name and an optional extra
X# condiction (e.g. "-x"). If the final argument is
X# missing it is set to 1 (ie always true).
X# It returns a list of matching files.
X# 
Xsub look
X{
X	local($dir, $file, $extra) = @_;
X	$extra = 1 unless $extra;
X	#print $debug "looking at $dir/$file\r\n";
X
X	opendir(DIR, $dir)	|| return "";
X	@contents = readdir(DIR);
X	closedir(DIR);
X
X	#print $debug "\rcontents @contents\n";
X	local(@match);
X	foreach (@contents)
X	{
X		#print $debug "matching $_\r\n";
X		if (/^$file/ && $extra)
X		{
X			push(@match, "$_");
X		}
X	}
X
X	sort @match;
X}
X
X#------------------ In built functions ----------------------------
X
X# Set up a pseudo-function or display them all.
Xsub function
X{
X	local($function)	= @_;
X	$function =~ s/\n$//;
X	if ($function)
X	{
X		if ($function =~ s/^(.)\s+//)
X		{
X			$ESCfunction{$1} = $function;
X			return 1;
X		}
X		return "";
X	}
X
X	# list the functions.
X	# print "function:\n";
X	local ($key);
X	foreach $key ( sort(keys(%ESCfunction)))
X	{
X		print "$key\t$ESCfunction{$key}\n";
X	}
X	1;
X}
X
X# Display the history.
Xsub history
X{
X	local($out) = @_;
X	$out = "STDOUT" unless $out;
X
X	for (local($i)=1; $i<=$#command; ++$i)
X	{
X		print $out "$i\t$command[$i]\n";
X	}
X}
X
X# Read the history from a file.
Xsub read_history
X{
X	local($historyfile) = @_;
X	if (open (HIST, "$historyfile"))
X	{
X		while (<HIST>)
X		{
X			chop;
X			$command[++$cmdnumber] = $_;
X		}
X		close (HIST);
X	}
X}
X
X# Write the history file.
Xsub write_history
X{
X	local($historyfile) = @_;
X	if (open (HIST, "> $historyfile"))
X	{
X		for (local($i)=1; $i<$#command; ++$i)
X		{
X			if ($command[$i])
X			{
X				print HIST "$command[$i]\n";
X			}
X		}
X		close (HIST);
X	}
X}
X
X# This unbinds the specified keys.
X# If there are no keys specified then it undoes them ALL.
X# except for "stop" and "newline".
Xsub unbind
X{
X	if (@_)
X	{
X
X		# un-bind the specified keys.
X		local ($_);
X		for (@_)
X		{
X			delete $bindings{&really(@_)};
X		}
X	}
X	else
X	{
X		# un-bind them all.
X		%bindings = ();
X	}
X
X	# Need these to exist.
X	$bindings{&Chardef'CTRL('D')} = "stop";
X	$bindings{&Chardef'CTRL('M')} = "newline";
X
X	&bind;
X
X	1;
X}
X
X# set up a binding or print them.
X# if there are no arguments then the whole list is printed.
X# if there is one argument then the binding for that character is shown.
X# if there are 2 arguments then that binding is made.
X# if there are 2 arguments the first being "-", then the
X# keys bound to the 2nd string, as a function, are listed.
Xsub bind
X{
X	local($binding) = join(" ", @_);
X
X	print $debug "bind: $binding\n";
X
X	unless ($binding)
X	{
X		# Print the bindings.
X		&showbindkeys(sort keys %bindings);
X		return 1;
X	}
X
X	# There's a binding to be made, perhaps.
X	local ($value, $action) = split(/\s+/, $binding);
X
X	unless ($action)
X	{
X		# only one argument to bind, so list binding.
X		$value = &really($value);
X		&showbindkeys($value);
X		return 1;
X	}
X
X	# correct the action name.
X	$action =~ s/-/_/g;
X
X	if ($value eq "-")
X	{
X		print $debug "single bind\n";
X		# find all the keys bound to the action.
X		local (@keys) = grep (
X					$bindings{$_} eq $action,
X					sort keys %bindings
X				);
X		&showbindkeys(@keys);
X		return 1;
X	}
X
X	# ok, now make a binding.
X	$value = &really($value);
X
X	# define individual action variables.
X	$bindings{$value} = "$action";
X
X	1;	# return.
X}
X
X# Returns the real character given the representation.
Xsub really
X{
X	local ($_) = @_;
X
X	return &Chardef'CTRL($_)	if s/^\^//;	# CTRL char.
X	return &Chardef'META($_)	if s/^M-//;	# META char.
X	return pack("c", oct($value))	if s/^\\(\d\d\d)/\1/;	# octal.
X	return pack("c", $value)	if /^\d\d+$/;	# decimal.
X	return "\177"			if /^DEL$/;	# delete key.
X
X	pack("c", ord($value));			# ordinary char.
X
X}
X
X# returns a character representation of a string, possibly containing
X# CTRL and META characters.  The inverse of &really.
Xsub representation
X{
X	local ($key) = @_;
X
X	local ($star) = $*;
X	$* = 1;
X
X	local ($rep, $letter);
X	while ($key =~ s/.// || $key =~ s/\012// || $key =~ s/\177//)
X	{
X		$letter = $&;
X		if (&Chardef'is_CTRL($letter))
X		{
X			$rep .= "^". &Chardef'UNCTRL($letter);
X		}
X		elsif (&Chardef'is_META($letter))
X		{
X			$rep .= "M-". &Chardef'UNMETA($letter);
X		}
X		elsif ($letter eq "\177")
X		{
X			$rep .= "DEL";
X		}
X		else
X		{
X			$rep .= $letter;
X		}
X	}
X
X	$* = $star;
X	$rep;
X}
X
X# display bindings for a list of keys.
Xsub showbindkeys
X{
X	local ($key);
X	for $key (@_)
X	{
X		print ord($key) . "\t";
X		print &representation($key);
X		print "\t$bindings{$key}\n";
X
X	}
X}
X
Xsub set_bind
X{
X	local ($value);
X	foreach $value (keys %ibindings)
X	{
X		# There's a binding to be made.
X		&bind ("$value $ibindings{$value}");
X	}
X}
X
X# This is the emergency stop.
Xsub stop
X{
X	system 'stty -raw echo';
X	print $debug "stopping!\n";
X	exit 1;
X}
X
X# This puts back the last piece of deleted text.
Xsub undelete
X{
X	$left .= $gone;
X	&pline();
X}
X
X# This collects the next key typed at the keyboard
X# and inserts it with any bind action.
Xsub real_char
X{
X	&add(getc($read));
X}
X
X# Print the current command line.
Xsub pline
X{
X	local ($old_len) = $last_line_len;
X	local ($l, $r)	= ($left, $right);
X
X	# Convert any hidden chars (eg CTRL) to visual.
X	$l = &representation($l);
X	$r = &representation($r);
X
X	# An attempt to indicate to the user that there are
X	# control characters in the line.
X	#$r =~ tr/\000-\010/\277/;
X	#$l =~ tr/\000-\010/\277/;
X
X	local($line)	= $prompt . $l . $r;
X
X	$last_line_len	= length ($line);		# global;
X
X	local($diff)	= $old_len - $last_line_len;
X	$diff		= 0 if ($diff < 0);
X	local($end)	= ' ' x $diff;
X
X	#print STDOUT "\r>>$prompt$l$r$end<<\n";
X
X	print STDERR "\r";
X	print STDERR $prompt;
X	print STDOUT $l, $r, $end;
X	print STDOUT "\b" x length($right), "\b" x $diff;
X
X}
X
X1;
X
END_OF_webster-1.0/lib/command.pl
if test 15769 -ne `wc -c <webster-1.0/lib/command.pl`; then
    echo shar: \"webster-1.0/lib/command.pl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f webster-1.0/lib/telnet.pl -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/lib/telnet.pl\"
else
echo shar: Extracting \"webster-1.0/lib/telnet.pl\" \(3902 characters\)
sed "s/^X//" >webster-1.0/lib/telnet.pl <<'END_OF_webster-1.0/lib/telnet.pl'
X;# 								
X;#  This code is freely available to however wants it. It can be	
X;#  distributed to anyone, and can be modified. The author takes	
X;#  no responsibilty for any errors in or caused by this code.	
X;# 								
X;#  Please retain my name and that of the Warwick University	
X;#  Geometry Group on any bits taken from this code. We reserve	
X;#  the copyright on this work.					
X;# 								
X;# 				Anthony Iano-Fletcher 		
X;# 				arf@maths.warwick.ac.uk		
X;# 								
X
X
Xpackage Telnet;
X
X# Telnet'open:
X# ------------
X# Takes a file handle, a target, a list of ports and
X# opens a connection as that file handle to the appriopiate port.
X# The list of ports (@ports) will be tried until a connection is
X# successful. 
X# Returns port number if successful, undef if not - error in $! of
X# LAST connection attempt.
X# If the port is a number then this is taken to be the port number.
X#
X# USAGE:
X#	$port = &Telnet'open(FD, machine, @ports) || die $!;
X
X# Telnet'serve:
X# -------------
X# Takes a file handle and a list of ports and
X# opens a connection as that file handle to the appriopiate port.
X# You can then listen of that file handle for connections.
X# The list of ports (@ports) will be tried until a connection is
X# successful. 
X# Returns port number if successful, undef if not - error in $! of
X# LAST connection attempt.
X# If the port is a number then this is taken to be the port number.
X#
X# USAGE:
X#	$port = &Telnet'serve(FD, @ports) || die $!;
X
XCONFIGURATION:
X{
X	$debug		= undef;
X	$AF_INET	= 2;
X	$SOCK_STREAM	= 1;
X	$sockaddr	= 'S n a4 x8';
X	$prototype	= 'tcp';
X	$Qsize		= 5;
X}
X
Xsub open
X{
X	local ($handle, $target, @ports) = @_;
X
X	# Where are we?
X	local ($host) = `hostname`;
X	chop ($host);
X	local ($port);
X
X	# correct $handle for the caller.
X	unless ($handle =~ /\'/)
X	{
X		local ($pack) = caller;
X		$handle = "$pack'$handle";
X		print $debug "calling package = $pack\n";
X	}
X
X	print $debug "handle = $handle\n";
X
X	# A lot of the next stuff is ripped straight out of the
X	# client/server example in ch6 of the book.
X
X	($name,$aliases,$proto)	= getprotobyname($prototype);
X
X	do {
X		$port = shift(@ports) || last;
X		print $debug "Trying port $port\n";
X		unless ($port =~ /^\d+$/)
X		{
X			print $debug "	looking up port $port\n";
X			($name,$aliases,$port) =
X					getservbyname($port,$prototype);
X		}
X
X	} until ($port =~ /^\d+$/);	# success.
X
X	print $debug "Using port $port\n";
X
X	($name,$aliases,$type,$len,$thisaddr) = gethostbyname($host);
X	($name,$aliases,$type,$len,$thataddr) = gethostbyname($target);
X
X	print $debug "local = $host\ttarget = $target\n";
X	print $debug "proto = $proto\n";
X	print $debug "name = $name\taliases = $aliases\n";
X	print $debug "sockaddr = $sockaddr\tthisaddr = $thisaddr\tthataddr = $thataddr\n";
X
X	$this = pack($sockaddr, $AF_INET, 0,     $thisaddr);
X	$that = pack($sockaddr, $AF_INET, $port, $thataddr);
X
X	# Make the socket filehandle.
X	socket($handle, $AF_INET, $SOCK_STREAM, $proto) || return undef;
X
X	# Give the socket an address.
X	bind($handle, $this) || return undef;
X
X	# Call up the server.
X	connect($handle, $that) || return undef;
X
X	print $debug "Successful connection via $handle.\n";
X
X	$port;
X}
X
Xsub serve
X{
X	local ($handle, @ports) = @_;
X
X	($name, $aliases, $proto) = getprotobyname($prototype);
X
X	local ($port);
X	do {
X		$port = shift(@ports) || last;
X		print $debug "Trying port $port\n";
X		unless ($port =~ /^\d+$/)
X		{
X			print $debug "	serve: looking up port $port\n";
X    			($name, $aliases, $port) =
X					getservbyport($port,$prototype);
X		}
X
X	} until ($port =~ /^\d+$/);	# success.
X
X	print $debug "serve: Using port $port\n";
X
X	$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
X
X	socket ($handle, $AF_INET, $SOCK_STREAM, $proto)|| return undef;
X	bind ($handle, $this)				|| return undef;
X	listen ($handle, $Qsize)			|| return undef;
X
X	select ((select($handle), $| = 1)[$[]);
X
X	$port;
X}
X
X# not sure what this should do.
Xsub close
X{
X	1;
X}
X
X1;
X
END_OF_webster-1.0/lib/telnet.pl
if test 3902 -ne `wc -c <webster-1.0/lib/telnet.pl`; then
    echo shar: \"webster-1.0/lib/telnet.pl\" unpacked with wrong size!
fi
chmod +x webster-1.0/lib/telnet.pl
# end of overwriting check
fi
if test -f webster-1.0/lib/debug.pl -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/lib/debug.pl\"
else
echo shar: Extracting \"webster-1.0/lib/debug.pl\" \(876 characters\)
sed "s/^X//" >webster-1.0/lib/debug.pl <<'END_OF_webster-1.0/lib/debug.pl'
X#! /usr/local/bin/perl
X
Xpackage debug;
X
XCONFIGURATION:
X{
X	$debug		= undef;
X}
X
X# print the string prepended by the calling functions name.
Xsub print
X{
X	local ($fn) = (caller(1))[3];
X
X	local ($pack) = $fn;
X	$pack =~ s/\'[^\']*$//;
X
X	local ($tmp);
X	eval "\$tmp = \$${pack}'debug;";
X
X	#warn "\$tmp = \$${pack}'debug;";
X	#warn "$pack $fn $tmp";
X
X	return unless $tmp;
X
X	print $tmp "$fn: @_\n";
X}
X
X# set the debug flags in the coreect packages.
Xsub set
X{
X	local ($_);
X	for (@_)
X	{
X		eval "package $_; \$debug = STDERR;";
X		warn "Can't set debug on package $_ ($@)\n" if $@;
X		warn "Setting debug on package $_\n" unless $@;
X	}
X
X	1;
X}
X
X# unset the debug flags in the coreect packages.
Xsub unset
X{
X	local ($_);
X	for (@_)
X	{
X		eval "package $_; \$debug = undef;";
X		warn "Can't unset debug on package $_ ($@)\n" if $@;
X		warn "Unsetting debug on package $_\n" unless $@;
X	}
X
X	1;
X}
X
X1;
X
END_OF_webster-1.0/lib/debug.pl
if test 876 -ne `wc -c <webster-1.0/lib/debug.pl`; then
    echo shar: \"webster-1.0/lib/debug.pl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f webster-1.0/lib/chardef.pl -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/lib/chardef.pl\"
else
echo shar: Extracting \"webster-1.0/lib/chardef.pl\" \(2492 characters\)
sed "s/^X//" >webster-1.0/lib/chardef.pl <<'END_OF_webster-1.0/lib/chardef.pl'
X
X;# 								
X;#  This code is freely available to however wants it. It can be	
X;#  distributed to anyone, and can be modified. The author takes	
X;#  no responsibilty for any errors in or caused by this code.	
X;# 								
X;#  Please retain my name and that of the Warwick University	
X;#  Geometry Group on any bits taken from this code. We reserve	
X;#  the copyright on this work.					
X;# 								
X;# 				Anthony Iano-Fletcher 		
X;# 				arf@maths.warwick.ac.uk		
X;# 								
X
X
X# Taken from the gnu readline library "chardefs.h"
X# Character definitions for readline. 
X
Xpackage Chardef;
X
XCONFIGURATION:
X{
X	$debug	= undef;
X
X	$control_character_threshold	= 0x020;
X					# smaller than this is control 
X	$meta_character_threshold	= 0x07f;
X					# larger than this is Meta. */
X	$control_character_bit		= 0x40;
X					# 0x000000, must be off. */
X	$meta_character_bit		= 0x080;
X					# x0000000, must be on. */
X	
X	$NEWLINE	= "\n";
X	$RETURN		= &CTRL('M');
X	$RUBOUT		= pack("c", 0x07f);
X	$TAB		= "\t";
X	$ABORT_CHAR	= &CTRL('G');
X	$PAGE		= &CTRL('L');
X	$SPACE		= " ";		# pack("c", 0x020);
X	$ESC		= &CTRL('[');
X	$BIZARRE	= "\277";	# pack("c", \277);
X}
X
Xsub is_CTRL
X{
X	local ($c) = @_;
X	ord($c) < $control_character_threshold;
X}
X
Xsub is_META
X{
X	local ($c) = @_;
X	ord($c) > $meta_character_threshold;
X}
X
X# Takes a character and turns it into the corresponding control
X# character. (i.e. &CTRL('C') = '^C');
Xsub CTRL
X{
X	local ($c) = @_;
X	pack ("c", (ord($c) & ~$control_character_bit));
X}
X
X# Takes a character and turns it into the corresponding meta
X# character. (i.e. &META('C') = 'M-C');
Xsub META
X{
X	local ($c) = @_;
X	pack ("c", (ord($c) | $meta_character_bit));
X}
X
X# Takes a meta character and turns it into the corresponding
X# character. (i.e. &UNCTRL('^C') = 'C');
Xsub UNCTRL
X{
X	local ($c) = @_;
X	pack ("c", (ord($c) | $control_character_bit)); # =~ tr/a-z/A-Z/;
X}
X
X# Takes a control character and turns it into the corresponding
X# character. (i.e. &UNMETA('M-C') = 'C');
Xsub UNMETA
X{
X	local ($c) = @_;
X	pack ("c", (ord($c) & ~$meta_character_bit));
X}
X
X# Debuging only.
Xif ($debug)
X{
X	print $debug "The defaults for chardef.\n\n";
X
X	print $debug "CTRL(X) = " . &CTRL('X') . ".\n";;
X	print $debug "NEWLINE = $NEWLINE.\n";
X	print $debug "RETURN = $RETURN.\n";
X	print $debug "RUBOUT = $RUBOUT.\n";
X	print $debug "TAB = $TAB.\n";
X	print $debug "ABORT_CHAR = $ABORT_CHAR.\n";
X	print $debug "PAGE = $PAGE.\n";
X	print $debug "BIZARRE = $BIZARRE.\n";
X	print $debug "CTRL(J) = ^" . &UNCTRL(&CTRL(J)) . ".\n";
X}
X
X1;
X
END_OF_webster-1.0/lib/chardef.pl
if test 2492 -ne `wc -c <webster-1.0/lib/chardef.pl`; then
    echo shar: \"webster-1.0/lib/chardef.pl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f webster-1.0/webster -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"webster-1.0/webster\"
else
echo shar: Extracting \"webster-1.0/webster\" \(6926 characters\)
sed "s/^X//" >webster-1.0/webster <<'END_OF_webster-1.0/webster'
X#! /usr/local/bin/perl
X'di';
X'ig00';
X$LIBDIR		= '/usr/local/lib/webster';
X$WEBSTERHOST	= '129.79.254.191';
X$VERSION	= '1.0;';
X#! /usr/local/bin/perl
X'di';
X'ig00';
X
X#
X# This code is freely available to whoever wants it. It can be   
X# distributed to anyone, and can be modified. The author takes   
X# no responsibilty for any errors in or caused by this code.     
X#  
X# Please retain my name and that of the Nottingham University       
X# Mathematics Department on any bits taken from this code. We 
X# reserve the copyright on this work. 
X#
X#			 Anthony Iano-Fletcher           
X#			 arf@maths.warwick.ac.uk         
X
X
X# Deal with builtin defaults.
X$LIBDIR		= "lib" unless $LIBDIR;
X$PERL		= "/usr/local/bin/perl" unless $PERL;
X$WEBSTERHOST	= "cs.indiana.edu" unless $WEBSTERHOST;
X$VERSION	= "developmental" unless $VERSION;
X
Xunshift (@INC, $LIBDIR);
X
X# Requires.
Xrequire 'telnet.pl';
Xrequire 'debug.pl';
Xrequire 'command.pl';
X
X# defaults.
X$program= $0;
X$program=~ s/.*\///;
X
X# Usage.
X$usage	= "Usage:\t$program -usage
X\t$program -version
X\t$program [-h <host>] [-s] [-d] <words>\n";
X
X$version = "Version $VERSION\n";
X
X# override WEBSTERHOST.
X$WEBSTERHOST = $ENV{WEBSTERHOST} if defined($ENV{WEBSTERHOST});
X
X# defaults
X@ports	= (2627, 103);
X$mode	= "DEFINE";
X$EOFCH	= sprintf("\200");
X@list	= ();
X
X# Process the command line.
Xwhile (@ARGV)
X{
X	$_ = shift(@ARGV);
X
X	if (s/^-//)
X	{
X		if (/^-$/)		{ last; }
X		elsif (/^h$/)		{ $WEBSTERHOST = shift; }
X		elsif (/^p$/)		{ unshift (@port, shift); }
X		elsif (/^d$/)		{ $mode = "DEFINE"; }
X		elsif (/^s$/)		{ $mode = "SPELL"; }
X		elsif (/^debug$/)	{ &debug'set(shift); }
X		elsif (/^version$/)	{ warn $version; exit 0; }
X		elsif (/^usage$/)	{ warn $usage; exit 0; }
X		else
X		{
X			warn "$program: unknown flag -$_\n";
X			die $usage;
X		}
X	}
X	else
X	{
X		unshift(@ARGV, $_);
X		last;
X	}
X}
X
X
X# connect to host.
X&Telnet'open(WEB, $WEBSTERHOST, @ports)
X		|| die "Can't connect to $WEBSTERHOST ($!).\n";
X
X# no buffering please.
X$|	= 1;
Xselect ((select(WEB), $| = 1)[$[]);
Xselect ((select(STDERR), $| = 1)[$[]);
X
X# Binary mode.
Xbinmode(WEB);
X
X# deal with command lines words.
Xif (@ARGV)
X{
X	for $word (@ARGV)
X	{
X		&send ("$mode $word");
X		&read;
X		print "\n";
X	}
X
X	exit;
X}
X
X# deal with interactive mode.
X#while (print STDERR "$mode: ", $word = <>)
X$Command'prompt = "$mode: ";
Xwhile ($word = &Command'get())
X{
X	next if ($word =~ /^\s+$/);	# ignore blank lines.
X
X	chop($word);
X
X	if ($word =~ /^\d+$/)
X	{
X		unless ($list[$word])
X		{
X			print "Word number $word not in list!\n";
X			next;
X		}
X		$word = $list[$word]
X	}
X
X	&send ("$mode $word");	
X	&read;
X	print "\n";
X}
X
Xexit;
X
X##### functions.
Xsub send 
X{
X	#print "send: @_\n";
X	print WEB "@_\r\n";
X}
X
Xsub read
X{
X	local ($w, $list, $_);
X
X	$_ = <WEB>; 
X
X	if (/^\s+$/)		{} # ignore blanks.
X	# Everything starting with ERROR is one.
X	elsif (/^ERROR\s+/)
X	{
X		warn $_;
X		return;
X	}
X	# DEFINITION <n> gives the number of x-refs, which follow.
X	elsif	(/^DEFINITION\s+(\d+)\s*/)
X	{
X		if ($1 > 0)
X		{
X			local ($no) = $1;
X			print "$no cross-references to $word:\n";
X			while ($no-- > 0)
X			{
X				$_ = <WEB>;
X				print;
X
X				# add to list.
X				s/[\r\n]*$//;
X				s/^(\d+)\s+//;
X				$list [$1] = $_;
X			}
X			print "\n";
X		}
X
X		print "$word:\n"; 
X	}
X	# SPELLING <n> gives the number of word matches
X	# 	n = 0 means incorrect spelling.
X	#	n = 1 means exactly right.
X	#	n > 1 means can find <n> matches to this pattern.
X	elsif	(/^SPELLING\s+0\s*/)
X	{
X		print "Unknown word $word.\n";
X		return;
X	}
X	elsif	(/^SPELLING\s+1\s*/)
X	{
X		print "Correct spelling: $word\n";
X		return;
X	}
X	elsif	(/^SPELLING\s+(\d+)\s*/)
X	{
X		print "Incorrect spelling for $word; $1 possibilities.\n";
X	}
X	elsif (/^SPELLING\s*$/) 
X	{
X		print "Here is a list of alternatives for $word:\n";
X		$list = 1;
X	}
X	# WILD 0 gives a negative responce to a pattern match.
X	# WILD gives a list of pattern matches.
X	elsif (/^WILD\s+0\s*$/) 
X	{
X		print "There no matches to $word:\n";
X		return;
X	}
X	elsif (/^WILD\s*$/) 
X	{
X		print "There are a number of matches to $word:\n";
X		$list = 1;
X	}
X	# Everything else is an error.
X	else
X	{
X		print "huh?: $_";
X		return;
X	}
X
X	# grab all the next info, ends with a $EOFCH.
X	local ($/) = $EOFCH;
X	$_ = <WEB>;
X	chop;
X	print;
X
X	# bodge!!!! yuk. Or else you lose the 1
X	# at the beginning of the list.
X	$_ = "R \n$_";	# RABBITS
X
X	# remember the list if there is one.
X	if ($list)
X	{
X		for $w (split(/\n/, $_))
X		{
X			next unless s/^\s*(\d+)\s+//;
X			$w =~ s/[\r\n]*$//;
X			$list[$1] = $w;
X		}
X	}
X
X}
X
X
X###############################################################
X
X	# These next few lines are legal in both Perl and nroff.
X
X.00;			# finish .ig
X
X'di			\" finish diversion--previous line must be blank
X.nr nl 0-1		\" fake up transition to first page again
X.nr % 0			\" start at page 1
X'; __END__ ##### From here on it's a standard manual page #####
X
X.TH WEBSTER 1 "March 9, 1993"
X.AT 3
X.SH NAME
Xwebster \- Webster dictionary. 
X.SH SYNOPSIS
X.B webster
X.RI [ -h <host> ]
X.RI [ -p <port> ]
X.RI [ -s ]
X.RI [ -d ]
X<words>
X.br
X.B webster
X.RI -usage
X.br
X.B webster
X.RI -version
X.SH DESCRIPTION
X.B Webster
Xconnects to a Webster dictionary server
Xand returns the spellings and/or definitions of the
Xspecified words.
X.LP
XIf there are words specified on the command line
Xthen
X.I webster
Xacts on those words and quits.
XOtherwise, it enters into interactive mode
X(which has some line editting features).
X.LP
XThere are two modes 
X(which can be set via the -d and -s flags):
X.TP
XDEFINE
XThis causes the server to return the definition of the specified words
X(this is the default).
X.TP
XSPELL
XThis causes the server to comment of the accuracy of the spelling.
XThe built-in default server is 
X.I cs.inidiana.edu.
X.SH OPTIONS
X.TP
X.I -usage
XThis gives a brief usage message and quits.
X.TP
X.I -version
XThis gives the version number and quits.
X.TP
X.I -h <host>
XThis sets the Webster disctionary host to connect to.
XThis overrides both the environment variable WEBSTERHOST
Xand the builtin default.
X.TP
X.I -p <port>
XThis sets the port of first choice.
XThe default is 2627.
X.TP
X.I -d
XThis sets the mode to be DEFINE (the default).
X.TP
X.I -s
XThis sets the mode to be SPELL.
X.SH ENVIRONMENT
XThe environment variable WEBSTERHOST
Xoverrides the builtin default.
X.SH "SEE ALSO"
Xperl (1).
X.SH AUTHOR
X." Anthony Iano-Fletcher <arf@maths.nott.ac.uk>
X.nf
XAnthony R Iano-Fletcher,
XDepartment of Mathematics,
XUniversity of Nottingham,
XNottingham, UK
Xarf@maths.nott.ac.uk
X.fi
X.SH COPYRIGHT
XThis code is freely available to whoever wants it. It can be   
Xdistributed to anyone, and can be modified. The author takes   
Xno responsibilty for any errors in or caused by this code.     
X 
XPlease retain my name and that of the Nottingham University       
XMathematics Department on any bits taken from this code. We 
Xreserve the copyright on this work. 
X.SH THANKS TO
XDavid A. Curry, who wrote an original client in C for BSD like machines,
Xwithout a manual page.
X.ex Anything after this line will be ignored by nroff.
END_OF_webster-1.0/webster
if test 6926 -ne `wc -c <webster-1.0/webster`; then
    echo shar: \"webster-1.0/webster\" unpacked with wrong size!
fi
chmod +x webster-1.0/webster
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0
------------------------------- cut here ------------------------

-- 
Anthony Iano-Fletcher
e-mail:		arf@maths.nott.ac.uk
telephone:	(0602) 51-4945