otherDemo.pl

Examples Guide POD

otherDemo.pl

#!/usr/bin/perl
use strict;
use warnings FATAL => qw(all);

# Demonstrates how to make use of Sloop::Other by forking and creating two
# servers.  If you make a request to the one in the foreground on port 8181,
# it will request some data from the one in the background and pass it on. 
# The other server may actually be any kind of TCP server.
#
# Use http://localhost:8181/stop to make sure both shut down properly.

use Sloop::Client::Request;
use Sloop::Logger::SimpleColor;
use Sloop::Other::Regular;
use Sloop::Server;

my $SLOOP_PORT = 8181;
my $OTHER_PORT = 8282;

my $pid = fork;

if (!defined $pid) {
    print "Fork failed: $!\n";
    exit 1;
}

if (!$pid) {
# As the other server, another sloop.
    my $sloop = Sloop::Server->new (
        logger => Sloop::Logger::SimpleColor->new('yellow'),
        port => $OTHER_PORT
    );
    die if !$sloop;

    $sloop->{handlers} = {
        '/' => sub {
            my $client = shift;
            $client->reply(\"Hello");
        },
        stop => sub {
            my $client = shift;
            $client->reply(\"ok");
            $client->setAfterReplyHandler(sub { exit 0 });
        }
    };
    $sloop->{logger}->out(2, "Background server starting...\n");
    $sloop->run;

} else {
# The foreground server.
    my $sloop = Sloop::Server->new (
        logger => Sloop::Logger::SimpleColor->new('cyan'),
        port => $SLOOP_PORT
    );
    die if !$sloop;

    # Create the Sloop::Other connection.
    my $other = Sloop::Other::Regular->new (
        dest_addr => '127.0.0.1',
        dest_port => $OTHER_PORT,
        incoming => [],
        logger => $sloop->{logger}
    );
    # This is mandatory; you can do it before you call run()
    # or later in a handler.
    $sloop->connectOther($other);

    $sloop->{handlers} = {
        '/' => sub {
            my $client = shift;
            push @{$other->{incoming}}, sub {
                my ($self, $raw) = (shift, shift);
            # We must deal with the possibility of multiple responses
            # in the raw input.  Note that no Sloop class uses attributes
            # with a leading underscore, so we may make use of such to our
            # own purposes here.
                my $msg = "";
                if ($self->{_data}) {
                # Retrieving any remainder from a previous call.
                    $msg = $self->{_data};
                    $self->{_data} = undef;
                }
                $msg .= $$raw;
            # For brevity, in context we can safely assume a complete HTTP
            # response is in there.  The first line of a response is the
            # status line, which is not a key: value header and must be
            # skipped before fed to getHeaders() -- hence the substr().
                $msg = substr($msg, index($msg, "\r\n") + 2);
                my $ref = \$msg;
                my $headers = Sloop::Client::Request::getHeaders($ref);
            # This leaves $ref as the actual body.
                my $length = $headers->{'content-length'};
                if ($length > length($msg)) {
                # Saving any remainder for the next call.
                    $self->{_data} = substr($$ref, $length);
                    $msg = substr($$ref, 0 , 5);
                } else { $msg = $$ref }
                $client->reply(\"<h2>$headers->{server} said '$msg'.");
                return 1;
            };
            $other->message(\"GET / HTTP/1.1\r\n\r\n");
        },
        # Remember to use this or you will leave the background server
        # running as an orphan.
        stop => sub {
            my $client = shift;
            push @{$other->{incoming}}, sub {
                $client->reply(\"<h1>Done.");
                $client->setAfterReplyHandler(sub { exit 0 });
            };
            $other->message(\"GET /stop HTTP/1.1\r\n\r\n");
        }
    };
    $sloop->{logger}->out(2, "Foreground server starting...\n");
    $sloop->run;
}