1# -*- perl -*- 2# 3# $Id: server,v 1.2 1999/08/12 14:28:59 joe Exp $ 4# 5# This example implements a very simple server, let's call it 6# multiplier. When a client connects, it waits for decimal numbers 7# as input. These numbers are written back, multiplied by 2. 8# 9 10require 5.004; 11use strict; 12 13use lib qw(blib/arch blib/lib); 14 15 16$| = 1; 17 18use Net::Daemon::Test (); 19use IO::Socket (); 20 21package Multiplier; 22 23use vars qw($VERSION @ISA); 24 25$VERSION = '0.01'; 26@ISA = qw(Net::Daemon::Test); 27 28 29sub Version ($) { 30 return "Multiplier - A simple network calculator; 1998, Jochen Wiedmann"; 31} 32 33sub GetLine { 34 my $sock = shift; 35 $sock->getline(); 36} 37 38sub Print { 39 my $sock = shift; 40 $sock->print(@_) && $sock->flush(); 41} 42 43sub Loop { 44 my $self = shift; 45 if ($self->{'loop-timeout'}) { 46 my $count = $self->{'loop-count'} || 0; 47 if (($self->{'loop-count'} = ++$count) == 10) { 48 $self->Done(); 49 open(COUNT, ">ndtest.cnt"); 50 print COUNT "10\n"; 51 close(COUNT); 52 } 53 } 54} 55 56sub Run ($) { 57 my $self = shift; 58 sleep 1 if $self->{'mode'} eq "fork"; 59 # Waiting one second sometimes helps the parent to catch 60 # children nicely, if they die immediately 61 my($line, $sock); 62 $sock = $self->{'socket'}; 63 eval { 64 while (1) { 65 if (!defined($line = GetLine($sock))) { 66 if ($sock->error()) { 67 die "Client connection error " . $sock->error() . " ($!)"; 68 } 69 last; 70 } 71 my $num; 72 { 73 my $lock = lock($Net::Daemon::RegExpLock) 74 if ($self->{'mode'} eq 'threads'); 75 if ($line =~ /(\d+)/) { 76 $num = $1; 77 } 78 } 79 if (defined($num)) { 80 if (!Print($sock, $num*2, "\n")) { 81 die "Client connection error " . $sock->error() . 82 " ($!) while writing."; 83 } 84 } else { 85 die "Server cannot parse input: $line"; 86 } 87 } 88 }; 89 if ($@) { 90 print STDERR "$@\n"; 91 $self->Error($@); 92 } 93 $sock->close(); 94} 95 96 97package main; 98 99my $server = Multiplier->new({ 'pidfile' => 'none' 100 }, \@ARGV); 101 102eval { $server->Bind() }; 103print STDERR "Unexpected return from Bind().\n" 104 if (!$server->Done()); 105 106print STDERR "Server died: $@\n" if $@; 107