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