App::Context::NetServer - context in which we are currently running
Index
Code Index:
NAME
App::Context::NetServer - context in which we are currently running
SYNOPSIS
# ... official way to get a Context object ...
use App;
$context = App->context();
$config = $context->config(); # get the configuration
$config->dispatch_events(); # dispatch events
# ... alternative way (used internally) ...
use App::Context::NetServer;
$context = App::Context::NetServer->new();
DESCRIPTION
A Context class models the environment (aka "context)
in which the current execution thread is running.
For the App::Context::NetServer class, this is the runtime environment
of a server with any of the following Net::Server personalities.
* Net::Server - generic, single-connection server
* Net::Server::INET - a server controlled by inetd
* Net::Server::Fork - a forking server
* Net::Server::PreForkSimple - a prefork server with constant # children
* Net::Server::PreFork - a prefork server with varying # children
Protected Methods:
The following methods are intended to be called by subclasses of the
current class.
_init()
The _init() method is called from within the standard Context constructor.
The _init() method sets debug flags.
* Signature: $context->_init($args)
* Param: $args hash{string} [in]
* Return: void
* Throws: App::Exception
* Since: 0.01
Sample Usage:
$context->_init($args);
Protected Methods
These methods are considered protected because no class is ever supposed
to call them. They may however be called by the context-specific drivers.
dispatch_events()
The dispatch_events() method is called at server startup.
This method is not expected to return control until the server
is exiting.
* Signature: $context->dispatch_events()
* Param: void
* Return: void
* Throws: App::Exception
* Since: 0.01
Sample Usage:
$context->dispatch_events();
send_response()
* Signature: $context->send_response()
* Param: void
* Return: void
* Throws: App::Exception
* Since: 0.01
Sample Usage:
$context->send_response();
request()
* Signature: $context->request()
* Param: void
* Return: void
* Throws: App::Exception
* Since: 0.01
Sample Usage:
$context->request();
The request() method gets the current Request being handled in the Context.
response()
* Signature: $context->response()
* Param: void
* Return: void
* Throws: App::Exception
* Since: 0.01
Sample Usage:
$context->response();
The response() method gets the current Request being handled in the Context.
Public Methods:
user()
The user() method returns the username of the authenticated user.
The special name, "guest", refers to the unauthenticated (anonymous) user.
* Signature: $username = $self->user();
* Param: void
* Return: string
* Throws: <none>
* Since: 0.01
Sample Usage:
$username = $context->user();
In a request/response environment, this turns out to be a convenience
method which gets the authenticated user from the current Request object.
#############################################################################
## $Id: NetServer.pm 6004 2006-05-02 13:52:30Z spadkins $
#############################################################################
package App::Context::NetServer;
$VERSION = (q$Revision: 6004 $ =~ /(\d[\d\.]*)/)[0]; # VERSION numbers generated by svn
use App;
use App::Context;
use Net::Server;
@ISA = ( "Net::Server", "App::Context" );
use App::UserAgent;
use strict;
#############################################################################
# DESCRIPTION
#############################################################################
#############################################################################
# PROTECTED METHODS
#############################################################################
#############################################################################
# _init()
#############################################################################
sub _init {
my ($self, $args) = @_;
$args = {} if (!defined $args);
}
#############################################################################
# PROTECTED METHODS
#############################################################################
#############################################################################
# dispatch_events()
#############################################################################
# conf_file "filename" undef
#
# log_level 0-4 2
# log_file (filename|Sys::Syslog) undef
#
# ## syslog parameters
# syslog_logsock (unix|inet) unix
# syslog_ident "identity" "net_server"
# syslog_logopt (cons|ndelay|nowait|pid) pid
# syslog_facility \w+ daemon
#
# port \d+ 20203
# host "host" "*"
# proto (tcp|udp|unix) "tcp"
# listen \d+ SOMAXCONN
#
# reverse_lookups 1 undef
# allow /regex/ none
# deny /regex/ none
#
# ## daemonization parameters
# pid_file "filename" undef
# chroot "directory" undef
# user (uid|username) "nobody"
# group (gid|group) "nobody"
# background 1 undef
# setsid 1 undef
#
# no_close_by_child (1|undef) undef
sub dispatch_events {
my ($self) = @_;
my $options = $self->options();
my @options = qw(
conf_file
log_level log_file
syslog_logsock syslog_ident syslog_logopt syslog_facility
port host proto listen
reverse_lookups allow deny
pid_file chroot user group background setsid
no_close_by_child
);
my (%options);
#foreach my $option (@options) {
# if (defined $options->{"netserver_$option"}) {
# $options{$option} = $options->{"netserver_$option"};
# }
#}
$self->run(%options); # this initiates the native event loop of Net::Server
$self->shutdown();
}
#############################################################################
# process_request()
# this is the interface that needs to be implemented for Net::Server
#############################################################################
sub process_request {
my $self = shift;
eval {
local $SIG{ALRM} = sub { die "Timed Out!\n" };
my $timeout = 10; # give the user 30 seconds to type a line
#my $header_sent = 0;
my $previous_alarm = alarm($timeout);
while (<STDIN>) {
s/\r?\n$//;
#if (!$header_sent) {
# print "Content-type: text/plain\n\n";
# $header_sent = 1;
#}
print "You said \"$_\"\r\n";
alarm($timeout);
}
alarm($previous_alarm);
};
if( $@=~/timed out/i ){
print STDOUT "Timed Out.\r\n";
return;
}
}
#############################################################################
# send_response()
#############################################################################
sub send_response {
my $self = shift;
my ($serializer, $response, $ctype, $content, $content_type, $headers);
$response = $self->response();
$content = $response->content();
if (ref($content)) {
$ctype = $self->so_get("default", "ctype", "default");
$serializer = $self->serializer($ctype);
$content = $serializer->serialize($content);
$content_type = $serializer->serialized_content_type();
}
$content_type = $response->content_type() if (!$content_type);
$content_type = "text/plain" if (!$content_type);
$headers = "Content-type: $content_type\n";
if (defined $self->{headers}) {
$headers .= $self->{headers};
delete $self->{headers}
}
#if ($self->{messages}) {
# my $msg = $self->{messages};
# $self->{messages} = "";
# $msg =~ s/<br>/\n/g;
# print "Content-type: text/plain\n\n", $msg, "\n";
#}
#else {
# print $headers, "\n", $content;
#}
}
#############################################################################
# set_header()
#############################################################################
sub set_header {
my ($self, $header) = @_;
if ($self->{headers}) {
$self->{headers} .= $header;
}
else {
$self->{headers} = $header;
}
}
#############################################################################
# request()
#############################################################################
sub request {
my $self = shift;
return $self->{request} if (defined $self->{request});
#################################################################
# REQUEST
#################################################################
my $request_class = $self->get_option("request_class");
if (!$request_class) {
$request_class = "App::Request";
}
eval {
$self->{request} = App->new($request_class, "new", $self, $self->{options});
};
$self->add_message("Context::NetServer::request(): $@") if ($@);
return $self->{request};
}
#############################################################################
# response()
#############################################################################
sub response {
my $self = shift;
return $self->{response} if (defined $self->{response});
#################################################################
# RESPONSE
#################################################################
my $response_class = $self->get_option("response_class", "App::Response");
eval {
$self->{response} = App->new($response_class, "new", $self, $self->{options});
};
$self->add_message("Context::NetServer::response(): $@") if ($@);
return $self->{response};
}
#############################################################################
# PUBLIC METHODS
#############################################################################
#############################################################################
# user()
#############################################################################
sub user {
my $self = shift;
return "guest";
#return $self->request()->user();
}
1;