Verified Commit d44bef3c authored by Adrian Schollmeyer's avatar Adrian Schollmeyer
Browse files

perl: Import Frontier::Daemon::Threading

parent be4aa9b8
Revision history for Perl extension Frontier::Daemon::Threading.
0.01 Wed Apr 10 15:00:00 2012
- initial release based on Frontier::Daemon::Forking 0.02.
Revision history for Perl extension Frontier::Daemon::Forking.
0.02 Tue Mar 8 21:47:40 2005
- optionally pass encoding attribute to Frontier::RCP->new ( Patch from Erik Wasser )
- updated SYNOPSIS to show encoding attribute
0.01 Mon Jan 5 09:44:45 2004
- original version; created by h2xs 1.20 with options
-AX -n Frontier::Daemon::Forking
Changes
Threading.pm
MANIFEST
Makefile.PL
test.pl
META.yml Module meta-data (added by MakeMaker)
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Frontier-Daemon-Threading
version: 0.01
version_from: Threading.pm
installdirs: site
requires:
Frontier::RPC2: 0
HTTP::Daemon: 0
HTTP::Status: 0
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'Frontier::Daemon::Threading',
'VERSION_FROM' => 'Threading.pm',
'PREREQ_PM' => {
'Frontier::RPC2' => 0,
'HTTP::Daemon' => 0,
'HTTP::Status' => 0,
},
($] >= 5.005 ?
(AUTHOR => 'Todd Caine <tcaine-at-pobox-dot-com>') : ()),
);
package Frontier::Daemon::Threading;
# $Id: Threading.pm,v 1.6 2004/01/23 19:48:33 tcaine Exp $
use strict;
use vars qw{@ISA $VERSION};
$VERSION = '0.02';
use Frontier::RPC2;
use HTTP::Daemon;
use HTTP::Status;
use Sys::Prctl qw(prctl);
#use threads;
@ISA = qw{HTTP::Daemon};
# most of this routine comes directly from Frontier::Daemon
# most of this routine comes directly from Frontier::Daemon::Forking
sub new {
my $class = shift;
my %args = @_;
my $encoding = delete $args{encoding};
my $self = $class->SUPER::new( %args );
return undef unless $self;
${*$self}{args_methods} = $args{methods};
${*$self}{args_encoding} = $encoding;
while ( 1 ) {
my $conn = $self->accept;
next unless $conn;
#threads->create(\&process_one_req, $self, $conn)->detach();
if (!fork()) {
prctl(1,9); # PR_SET_PDEATHSIG + SIGKILL
$0 = "xmlrpc connection";
process_one_req($self, $conn);
kill 9, $$; # SIGKILL myself
die("child exit");
}
undef($conn);
}
}
sub process_one_req {
my $self = shift;
my $conn = shift;
my $request = $conn->get_request;
if ($request) {
if ($request->method eq 'POST' && $request->url->path eq '/RPC2') {
my $encoding = ${*$self}{args_encoding};
my $methods = ${*$self}{args_methods};
my @options;
push @options, encoding => $encoding if $encoding;
my $frontier = new Frontier::RPC2(@options);
my $ret = $frontier->serve($request->content, $methods);
my $response = new HTTP::Response 200;
$response->header( 'Content-Type' => 'text/xml' );
$response->content($ret);
$conn->send_response($response);
undef($ret);
undef($response);
undef($frontier);
} else {
$conn->send_error(RC_FORBIDDEN);
}
}
$conn->close();
undef($conn)
}
1;
__END__
=head1 NAME
Frontier::Daemon::Threading - receive Frontier XML RPC requests
=head1 SYNOPSIS
use Frontier::Daemon::Threading;
Frontier::Daemon::Threading->new(
methods => {
rpcName => \&rpcHandler,
},
encoding => 'ISO-8859-1',
);
sub rpcHandler { return 'OK' }
=head1 DESCRIPTION
L<Frontier::Daemon::Threading> is a drop in replacement for L<Frontier::Daemon> when a forking into threads HTTP/1.1 server is needed that listens on a socket for incoming requests containing Frontier XML RPC2 method calls. Most of the code was borrowed from L<Frontier::Daemon> and L<Frontier::Daemon::Forking>.
=head1 AUTHOR
Michael Braun, michael-dev@fami-braun.de
=head1 SEE ALSO
L<Frontier::RPC2>, L<Frontier::Daemon>, L<HTTP::Daemon>, L<Frontier::Daemon::Forking>
=cut
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use Frontier::Daemon::Threading;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment