Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2022-11-30 10:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?