use IO::Socket;

 # optional stuff to make init.d calling work
 my $pidFile = '/var/run/something.pid';
 my $pid = fork;
 if ($pid) # parent: save PID
 {
  open PIDFILE, ">$pidFile" or die "Can't open PID file: $!\n";
  print PIDFILE $pid;
  close PIDFILE;
  exit 0;
 }
 # end of optional init.d stuff


my $port = 8000;
my $proto = 'tcp';
my %kids = ();

# do stuff when we are forced to exit
$SIG{"TERM"} = "cleanup_and_exit";

  sub cleanup_and_exit {
    my $sig = @_;
    foreach my $kid (keys %kids) {
      # attempt to reap the kiddies
      warn ("Failed to reap child pid: $kid") unless kill 9, $kid;
    }
    # it's a good idea to exit when you are told to
    exit(0);
  }

# set up a socket
my $listen_socket = IO::Socket::INET->new(LocalPort => $port,
                                          Listen => 10,
                                          Proto => $proto,
                                          Reuse => 1);

while (my $connection = $listen_socket->accept)
{
    my $child;
    # perform the fork or exit
    die "Can't fork: $!" unless defined ($child = fork());
    if ($child == 0) { # i'm the child!
        # close the child's listen socket, we dont need it.
        $listen_socket->close;
        # call the main child rountine
        &some_routine($connection);
        # if the child returns, then record and exit;
        undef $kids{$child};
        exit 0;
    } else { # i'm the parent!
        # remember the pid of any children for later reaping
        $kids{$child} = 1;
        # close the connection, the parent has already passed
        #   it off to a child.
        $connection->close();
    }
    # go back and listen for the next connection!
}

sub some_routine {
  my $socket = shift;
  # go for it here ...
  # but don't forget to exit
  exit(0);
}