package ServerApp;
use strict;
use HTTP::Daemon;
use HTTP::Status;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
$VERSION = ".001";
## not only PRE-ALPHA code, but SPECULATIVE, EXPERIMENTAL probing in t
+he dark at a possibly original concept - go easy.
use constant DEBUG => 0;
use constant DEBUG_BASIC => 0;
sub new {
my $self = shift;
my ($args) = @_;
#use Data::Dumper; print Dumper($args);
die "Need a port" if !$args->{Port};
$self = {};
$self->{'_async'} = $args->{_async} ? 1 : 0;
$self->{'_daemon'} = new HTTP::Daemon(
LocalAddr => '127.0.0.1',
LocalPort => $args->{Port},
);
$self->{'_handlers'} = $args->{With} ? $args->{With} : [] ;
return bless($self, 'ServerApp');
}
sub run_with {
my $self = shift;
my @paths = @_;
return $self->_run(@paths);
}
sub daemon { return $_[0]->{'_daemon'} }
sub async { return $_[0]->{'_async'} }
sub handlers { return $_[0]->{'_handlers'} }
sub _run {
my $self = shift;
my @paths = @_;
unshift(@paths, @{ $self->handlers });
my $d = $self->daemon;
print " ready @: <URL:", $d->url, ">\n" if DEBUG_BASIC;
while (my $c = $d->accept) {
my $r = $c->get_request;
if ($r) {
print "REQUEST: " . Dumper($r) . "" if DEBUG_BASIC;
my $res = new HTTP::Response( 200, "OK" );
my $result = handleRequest($r, @paths);
if( $result->{content} ) {
$res->header( -content_type => "text/html" );
$res->content( $result->{content} );
}
elsif( $result->{js} ) {
use Data::JavaScript::Anon;
$res->header( -content_type => " application/x-javascr
+ipt" );
$res->content( Data::JavaScript::Anon->anon_dump($res
+ult->{js}) );
}
$c->send_response($res);
if( exists $result->{exit_with} ) {
$c = undef; # close connection
return $result->{exit_with};
}
#~ print "FOUR OH FOUR\n";
#~ #$c->send_error(RC_FORBIDDEN);
print " --------------------------\n" if DEBUG_BASIC;
}
$c = undef; # close connection
}
}
sub handleRequest {
my ($req, @paths) = @_;
my $result = {};
foreach( @paths ) {
my ($match, $fcn, $ret) = @$_;
my $info = checkIfMatches($req, $match);
if( DEBUG ) {
use Data::Dumper;
print $req->url->path . " vs. " . Dumper($match) . " = " .
+ ($info ? "(yes): " . Dumper($info) . "\n" : "(no)\n\n");
}
next unless $info;
if( ref($fcn) eq 'CODE') {
$result = &$fcn($req, $info);
}
else {
$result = $fcn;
}
if( ref($result) eq '' ) {
$result = { content => $result };
}
if( DEBUG ) {
use Data::Dumper;
print Dumper( $result );
}
if( $ret ) {
if( ref($ret) eq 'CODE') {
$result->{exit_with} = &$ret($req);
}
else {
$result->{exit_with} = $ret;
}
print "Will exit with $result->{exit_with}" if( DEBUG ) ;
}
return $result;
}
if( DEBUG ) {
print "404\n\n";
}
return { content=> "404:\n" . Dumper($req) };
}
sub checkIfMatches {
my ($req, $match) = @_;
my $ref = ref($match);
print "\tChecking a " . ($ref ne '' ? $ref : "String($match)") . "
+ against: " . $req->url->path . "..\n" if DEBUG;
if( $ref eq 'Regexp' ) {
if( $req->url->path =~ $match ) {
return { type => $ref, matches => [$req->url->path, $1, $2
+, $3, $4, $5, $6, $7, $8, $9] };
}
}
elsif( $ref eq 'CODE') {
my $r = &$match($req);
print "\t\t\treturned: " . Dumper($r) . "\n" if DEBUG;
if( $r ) {
return { type => $ref, value => $r };
}
}
elsif( $ref eq 'ARRAY') {
#any of, or all of these? anyway to indicate one or the other?
foreach( @$match ) {
my $v = checkIfMatches($req, $_);
return { type => $ref, matched => $_, result => $v } if $v
+;
}
}
elsif( $ref eq 'HASH') {
return { type => $ref, value => $match->{$req} } if exists($ma
+tch->{$req});
}
elsif( $ref eq '') {
return { type => $ref, value => 1 } if $req->url->path =~ /^\/
+?$match$/;
}
else {
warn "Unknown ref(): $ref";
}
return undef;
}
1;
In reply to ServerApp
by qbxk
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.