File: 07-envdir-print.pl

package info (click to toggle)
libserver-starter-perl 0.17-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 332 kB
  • ctags: 176
  • sloc: perl: 2,545; makefile: 2
file content (30 lines) | stat: -rwxr-xr-x 579 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#! /usr/bin/perl

use strict;
use warnings;

use lib qw(blib/lib lib);

use IO::Socket::INET;
use Server::Starter qw(server_ports);

$SIG{TERM} = $SIG{USR1} = sub {
    exit 0;
};
$ENV{PID} = $$;

my $listener = IO::Socket::INET->new(
    Proto => 'tcp',
);
$listener->fdopen((values %{server_ports()})[0], 'w')
    or die "failed to bind listening socket:$!";

while (1) {
    if (my $conn = $listener->accept) {
        my $s = "";
        for my $envkey (sort keys %ENV) {
            $s .= $envkey . "=" . $ENV{$envkey} . "\n";
        }
        $conn->syswrite($s);
    }
}