On 8/14/06, al davis <[EMAIL PROTECTED]> 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 [email protected] http://www.seul.org/cgi-bin/mailman/listinfo/geda-user
