Re: gEDA-user: New features in gattrib

["John Luciani" <jluciani@xxxxxxxxx>]

On 8/14/06, al davis <ad106@xxxxxxxxxxxxxxxx> wrote:

> How about a pair of little demo programs.  Make one send, the
> other receive, just to demonstrate the concept.

Al,

Below are two little programs that demo socket communication.
They are derived from the component attribute server I am
working on that is documented at

http://www.luciani.org/not-quite-ready/doc/compsrv.pdf

The server responds to two commands get and help.  The get command
returns a string containing the command arguments.  The help command
sends a help message. command strings consist of a command name
followed by command arguments. the command name and args are
separated by vertical bars.

N.B. This was a quick cut-and-paste. It works on my system ;-)

(* jcl *)

--
http://www.luciani.org


############ server

#!/usr/bin/perl -w

# server demo program

# (* jcl *)

use strict;
use warnings;
use Carp;
use Data::Dumper;

use IO::Socket;
use Net::hostent;

my $Port = 9000;
my $Server = IO::Socket::INET->new( Proto     => 'tcp',
                                   LocalPort => $Port,
                                   Listen    => SOMAXCONN,
                                   Reuse     => 1);
my $EOM = "\r\n";
die "can't setup server" unless $Server;
print "[Server $0 accepting clients at http://localhost:$Port/]\n";;

# The command is the first non-whitepsace string on the line the remainder
# of the line is command args.

# The %Subs hash defines command names and the subroutine to process a
# command.

my %Subs = (get   => \&get,
           help  => \&help);

my $Client;
while ($Client = $Server->accept()) {
   $Client->autoflush(1);
   my $hostinfo = gethostbyaddr($Client->peeraddr);
   printf "[Connect from %s]\n", $hostinfo->name || $Client->peerhost;
   while ( <$Client>) {
	if (s/\\\s*$//) {    # Remove the continuation backslash and
	    $_ .= <>;        # append the next line to $_ then
	    redo unless eof; # restart the loop block after the conditional
	}
	print "(compsrv) skipping received string that does not contain a
\\r\\n\n" unless /$EOM/;
	next unless s/$EOM//s;
	s/^\s*//; # Remove leading spaces
	s/\s*$//; # Revove trailing spaces
	print($Client "error: received string had zero length$EOM"), next
unless length;
	my ($cmd, @arg) = split /\s*\|\s*|\s*=\s*/;
	printf("cmd = %s\n", defined $cmd ? $cmd : 'undef');
	print($Client "error: undefined command in received string$EOM"),
next unless defined $cmd;
	print($Client "error: no procedure for command $cmd$EOM"), next
unless defined $Subs{$cmd};
	no strict qw(subs);
	print $Client $Subs{$cmd}->(@arg);
	use strict qw(subs);
   }
   close $Client;
}

sub help {
   my $helpmsg =<<'END';
get ............. get
help ............ command summary
END
return("$helpmsg\r\n")
}

sub get($) {
   my (@arg) = @_;
   return(sprintf("get command called with %s$EOM", $#arg == -1 ? "no
args" : join(" | ", @arg)));
}


###########  client

#!/usr/bin/perl -w

# client demo program

# (* jcl *)

use strict;
use Compsrv;
use Data::Dumper;
use IO::Socket;

my $Port = 9000;
my $IP = "127.0.0.1";
my $Socket = IO::Socket::INET -> new( "$IP:$Port");
my $EOM = "\r\n";
printf(" cmd ? ");
while (1) {
   my $send_str = <STDIN>;
   my $recv_str;
   $send_str =~ chomp($send_str);
   print $Socket "$send_str$EOM";
   print "\n\n";
   printf("(send) %s\n", $send_str);
   while (<$Socket>) {
	$recv_str .= $_;
	last if /$EOM/;
   }
   printf("(recv)\n%s\n\n\n", $recv_str);
   print " cmd ? ";
}


_______________________________________________
geda-user mailing list
geda-user@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-user