File Coverage

blib/lib/Perlbal/ClientManage.pm

Criterion	Covered	Total	%
statement	39	95	41.0
branch	6	30	20.0
condition	0	2	0.0
subroutine	8	15	53.3
pod	5	6	83.3
total	58	148	39.1

######################################################################
# Management connection from a client
######################################################################

package Perlbal::ClientManage;
use strict;
use warnings;
no  warnings qw(deprecated);

use base "Perlbal::Socket";
use fields ('service',
            'buf',
            'is_http',  # bool: is an HTTP request?
            'ctx',      # command context
            );

# ClientManage
sub new {
    my Perlbal::ClientManage $self = shift;
    my ($service, $sock) = @_;
    $self = fields::new($self) unless ref $self;
    $self->SUPER::new($sock);
    $self->{service} = $service;
    $self->{buf} = "";   # what we've read so far, not forming a complete line

    $self->{ctx} = Perlbal::CommandContext->new;
    $self->{ctx}->verbose(1);

    $self->watch_read(1);
    return $self;
}

# ClientManage
sub event_read {
    my Perlbal::ClientManage $self = shift;

    my $bref;
    unless ($self->{is_http}) {
        $bref = $self->read(1024);
        return $self->close() unless defined $bref;
        $self->{buf} .= $$bref;

        if ($self->{buf} =~ /^(?:HEAD|GET|POST) /) {
            $self->{is_http} = 1;
            $self->{headers_string} .= $$bref;
        }
    }

    if ($self->{is_http}) {
        my $hd = $self->read_request_headers;
        return unless $hd;
        $self->handle_http();
        return;
    }

    while ($self->{buf} =~ s/^(.+?)\r?\n//) {
        my $line = $1;

        if ($line =~ /^quit|exit$/) {
            $self->close('user_requested_quit');
            return;
        }

        my $out = sub {
            $self->write("$_[0]\r\n");
        };

        Perlbal::run_manage_command($line, $out, $self->{ctx});
    }
}

sub event_write {
    my $self = shift;
    $self->watch_write(0) if $self->write(undef);
}

# ClientManage
sub event_err {  my $self = shift; $self->close; }
sub event_hup {  my $self = shift; $self->close; }

# HTTP management support
sub handle_http {
    my Perlbal::ClientManage $self = shift;

    my $uri = $self->{req_headers}->request_uri;

    my $body;
    my $code = "200 OK";

    my $prebox = sub {
        my $cmd = shift;
        my $alt = shift;
        $body .= "$cmd";
        Perlbal::run_manage_command($cmd, sub {
            my $line = $_[0] || "";
            $alt->(\$line) if $alt;
            $body .= "$line\n";
        });
        $body .= "\n";

    };

    $body .= "\n";
    $body .= "\n";
    $body .= "perlbal management interface";

    if ($uri eq "/") {
        $body .= "perlbal management interface";
        $body .= "Sockets";
        $body .= "Perl Objects in use";
        $body .= "Service Details";
        foreach my $sname (Perlbal->service_names) {
            my Perlbal::Service $svc = Perlbal->service($sname);
            next unless $svc;
            my $listen = $svc->{listen} ? " ($svc->{listen})" : "";
            $body .= "$sname - $svc->{role}$listen\n";
        }
        $body .= "";
        $body .= "";
    } elsif ($uri eq "/socks") {
        $prebox->('socks summary');

        $prebox->('socks', sub {
            ${$_[0]} =~ s!service \'(\w+)\'!$1!;
        });
    } elsif ($uri eq "/obj") {
        $prebox->('obj');
    } elsif ($uri =~ m!^/service\?(\w+)$!) {
        my $service = $1;
        $prebox->("show service $service");
    } else {
        $code = "404 Not found";
        $body .= "$code";
    }

    $body .= "Perlbal management.\n";
    $self->write("HTTP/1.0 $code\r\nContent-type: text/html\r\nContent-Length: " . length($body) .
                 "\r\n\r\n$body");
    $self->write(sub { $self->close; });
    return;
}

1;


# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End: