FCGI-Engine-0.22/000755 000765 000024 00000000000 12376456042 014024 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/Changes000644 000765 000024 00000015127 12376454167 015333 0ustar00stevanstaff000000 000000 Revision history for Perl extension FCGI-Engine 0.22 Sun, Aug. 24th, 2014 - Add $request object to params passed to handle_request to support FCGI forking in request handler. (thanks to Robert Decker) 0.21 Thu. Apr. 11, 2013 - Fix RT#83636 by correctly importing the Config module. 0.20 Mon. Feb. 25, 2013 - Use Config to find perl to run RT#69473 0.19 Wed. Oct. 5, 2011 - Fix tests to not fail when MooseX::NonMoose isn't installed. - exit 0 without writing a Makefile.PL rather than dieing with an error code. exit(0) preferred by the toolchain. - Add FCGI::Engine::ProcManager::Constrained subclass to manage restarting children on over-memory or after a certtain number of requests. 0.18 Mon. Nov. 15, 2010 - fixing the plack -E flag (it changed) - changing plackup usage to --daemonize instead of --detach (it is more useful this way) - changing plackup usage to --pid instead of --pidfile (also more useful this way) - added optional --workers to plackup server manager as an alternate to --nproc. this makes it possible to use it with Starman, and other plack backends too. (^^ all these changes above thanks to bricas) 0.17 Tues. Oct. 12, 2010 - fixing the TCP --listen option to follow the correct : format (thanks to Andreas Marienborg for spotting this) 0.16 Sat. July 10, 2010 - Fix bug: Exiting subroutine via next in ProcManager (fixed by Johannes Plunien) - add new attribute 'use_manager' so the ProcManager can be used even if you're not listening (thanks to Johannes Plunien) - added tests for this as well - updating the Plack tests to work with the latest plack and it's Lighttd fixes 0.15 Sat. April 17, 2010 - fixing Plack support to work with the latest Plack version - changed Plack::Server:: to Plack::Handler:: - Plack::Server:: is deprecated and will be removed in subsequent releases - adjusted tests to use Plack::Handler:: - updated FCGI::Engine::PSGI to more closely follow what is in Plack::Handler::FCGI 0.14 Mon. Feb. 22, 2010 - updating copyright on all files - updating some test files to require YAML::XS since YAML and YAML::Syck are not the suggested YAML parser for Config::Any - thanks to Justin "arcanez" Hunter 0.13 Thurs. Dec. 31, 2009 - fixing test files that were causing false CPAN Tester failings (Jay Shirley) - pushed all dependencies up to the latest versions, might also help some odd CPAN Tester failures 0.12 Tues. Dec. 29. 2009 + FCGI::Engine::PSGI - run PSGI applications using FCGI::Engine - added tests for this + FCGI::Engine::Core - base class for FCGI::Engine flavors * FCGI::Engine - refactored to use FCGI::Engine::Core + Plack::Server::FCGI::Engine + Plack::Server::FCGI::Engine::ProcManager - subclasses to make it easier to use the FCGI::Engine::ProcManager with your Plack based application - added tests for this * FCGI::Engine::Manager::Server::Plackup - this now uses Plack::Server::FCGI::Engine by default (can be overriden with the 'server_type' option) 0.11 Thurs. Dec. 10, 2009 + FCGI::Engine::Manager::Server::Plackup - added support for running Plack based apps using the FCGI::Engine::Manager controls - added tests for this - NOTE: we do not depend on Plack, you are expected to have it installed if you use this module. * FCGI::Engine - adding some more PATH_INFO and SCRIPT_NAME fixes found in Catalyst::Engine::FastCGI and Plack::Server::FCGI 0.10 Fri. Aug. 7, 2009 * FCGI::Engine::Manager - fixing broken call to remove pid object in start (when a pid file exists but the server is not running) 0.09 Sat. July 18, 2009 * FCGI::Engine::Manager - fixing broken call to remove pid object in graceful restart (arcanez) 0.08 Sun. Mar. 8, 2009 * FCGI::Engine::Types - fixing this to work with the latest Moose as well as older Moose * FCGI::Engine::ProcManager - removed usage of MooseX::Params::Validate 0.07 Tues. Feb. 24, 2009 - Getting rid of the Mac resource forks (steve jobs--) 0.06 Tues. Feb. 24, 2009 - Fix so start doesn't start another set of procs (marcus) - Add graceful method to do a restart with start before killing old processes. (marcus) - Don't stop all servers if a server fails to start. (marcus) 0.05 Sat. July 12, 2008 * FCGI::Engine::Manager - added restart feature (thanks to Brian Cassidy) - added tests for this - added ability to start, stop and restart individual servers within the conf (thanks to Brian Cassidy) - added tests for this - fixed my ugly hack of a ->status method (thanks to Brian Cassidy) - added tests for this - tweaked the SYNOPSIS to provide a better example of usage (also thanks to Brian Cassidy) 0.04 Thurs. July 10, 2008 - upped the MooseX::Getopt dependency since the old version was causing a test failure in certain cases * FCGI::Engine - added docs about our usage of CGI::Simple (RT #35786) - added docs about usage with Catalyst (RT #34488) - added the handler_args_builder option to make it easier to override the default arguments passed into the handler_method (RT #33885) (thanks to Bradley C. Bailey for the idea and initial patch) - added tests for this * FCGI::Engine::Manager - added docs about usage with Catalyst (RT #34488) - added example of the config file * t/ - fixed the FCGI::Engine::Manager test to make sure there is a YAML parser available for Config::Any to use. 0.03 Sun. Feb. 3, 2008 * FCGI::Engine - handler_method was not being used properly to dispatch with (reported by Reed A. Cartwright) - added tests for this - %additional_options can now be passed to run, which will then be passed to both the pre_fork_init sub and the proc_manager's constructor - added tests for this - handler_class can now also be an instance if nessecary (thanks to Chris Prather) * FCGI::Engine::ProcManager - added the manager_process_name and the process_name options to allow custom process naming - added test for this 0.02 Fri. Jan. 11, 2008 - fixing dependency issues 0.01 Fri. Jan. 11, 2008 - hello world FCGI-Engine-0.22/inc/000755 000765 000024 00000000000 12376456042 014575 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/000755 000765 000024 00000000000 12376456042 014572 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/Makefile.PL000644 000765 000024 00000002161 12376455051 015775 0ustar00stevanstaff000000 000000 use strict; use warnings; use inc::Module::Install; if ($^O eq 'Win32' or $^O eq 'cygwin') { print STDERR "This module is not for use on Windows, sorry."; exit 0; } name 'FCGI-Engine'; all_from 'lib/FCGI/Engine.pm'; license 'perl'; # prereqs requires 'Moose' => 0.93; requires 'MooseX::Daemonize' => 0.09; requires 'MooseX::Getopt' => 0.26; requires 'MooseX::Types::Path::Class'; requires 'MooseX::NonMoose'; requires 'Declare::Constraints::Simple'; requires 'FCGI'; requires 'CGI::Simple'; requires 'POSIX'; requires 'Config::Any'; requires 'Class::Load'; feature 'Plack Support', -default => 0, 'MooseX::NonMoose' => 0.07, 'Plack' => 0.9910, 'FCGI::Client' => 0.06, # for the tests 'IO::String' => 0; # for the tests # things the tests need build_requires 'Test::More' => '0.88'; build_requires 'Test::Exception'; build_requires 'Test::WWW::Mechanize'; build_requires 'File::Spec'; build_requires 'FindBin'; build_requires 'Cwd'; tests('t/*.t'); resources( 'repository', => 'git://github.com/bobtfish/fcgi-engine.git', ); WriteAll(); FCGI-Engine-0.22/MANIFEST000644 000765 000024 00000002673 12376456020 015161 0ustar00stevanstaff000000 000000 Changes inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/FCGI/Engine.pm lib/FCGI/Engine/Core.pm lib/FCGI/Engine/Manager.pm lib/FCGI/Engine/Manager/Server.pm lib/FCGI/Engine/Manager/Server/FreeBSD6.pm lib/FCGI/Engine/Manager/Server/Plackup.pm lib/FCGI/Engine/ProcManager.pm lib/FCGI/Engine/ProcManager/Constrained.pm lib/FCGI/Engine/PSGI.pm lib/FCGI/Engine/Types.pm lib/Plack/Handler/FCGI/Engine.pm lib/Plack/Handler/FCGI/Engine/ProcManager.pm lib/Plack/Server/FCGI/Engine.pm lib/Plack/Server/FCGI/Engine/ProcManager.pm Makefile.PL MANIFEST This list of files META.yml README t/000_load.t t/001_basic.t t/002_basic_with_listen.t t/003_basic_with_options.t t/004_basic_psgi.t t/010_errors.t t/020_basic_manager.t t/021_manager_opts.t t/022_more_manager_opts.t t/023_manager_w_plackup.t t/024_manager_wo_listen.t t/030_proc_manager.t t/050_lighttpd_basic_test.t t/051_lighttpd_basic_tcp_test.t t/100_plack_server_fcgi_engine.t t/101_plack_server_fcgi_engine_client.t t/102_plack_server_fcgi_compat.t t/confs/test_conf.yml t/confs/test_plack_conf.yml t/lib/FCGIUtils.pm t/lib/utils.pm t/lighttpd_confs/050_lighttpd_basic_test.conf t/lighttpd_confs/051_lighttpd_basic_tcp_test.conf t/lighttpd_confs/fcgi_engine.lighttpd.base.conf t/pod.t t/scripts/bar.pl t/scripts/baz.psgi t/scripts/foo.pl FCGI-Engine-0.22/META.yml000644 000765 000024 00000001642 12376455115 015300 0ustar00stevanstaff000000 000000 --- abstract: 'A flexible engine for running FCGI-based applications' author: - 'Stevan Little ' build_requires: Cwd: 0 ExtUtils::MakeMaker: 6.36 File::Spec: 0 FindBin: 0 Test::Exception: 0 Test::More: '0.88' Test::WWW::Mechanize: 0 configure_requires: ExtUtils::MakeMaker: 6.36 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.10' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: FCGI-Engine no_index: directory: - inc - t requires: CGI::Simple: 0 Class::Load: 0 Config::Any: 0 Declare::Constraints::Simple: 0 FCGI: 0 Moose: 0.93 MooseX::Daemonize: 0.09 MooseX::Getopt: 0.26 MooseX::NonMoose: 0 MooseX::Types::Path::Class: 0 POSIX: 0 resources: license: http://dev.perl.org/licenses/ repository: git://github.com/bobtfish/fcgi-engine.git version: '0.22' FCGI-Engine-0.22/README000644 000765 000024 00000001344 12376454206 014706 0ustar00stevanstaff000000 000000 FCGI-Engine version 0.22 =========================== See the individual module documentation for more information INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Moose MooseX::Daemonize MooseX::Getopt MooseX::Types::Path::Class Declare::Constraints::Simple FCGI CGI::Simple POSIX Config::Any For Plack support: MooseX::NonMoose Plack COPYRIGHT AND LICENCE Copyright (C) 2007-2014 Infinity Interactive, Inc. http://www.iinteractive.com This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. FCGI-Engine-0.22/t/000755 000765 000024 00000000000 12376456042 014267 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/t/000_load.t000644 000765 000024 00000000327 12376445246 015760 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More 0.88; BEGIN { use_ok('FCGI::Engine'); use_ok('FCGI::Engine::ProcManager'); use_ok('FCGI::Engine::ProcManager::Constrained'); } done_testing; FCGI-Engine-0.22/t/001_basic.t000644 000765 000024 00000002336 12376445246 016125 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 16; use Test::Moose; BEGIN { use_ok('FCGI::Engine'); } { package Foo; sub handler { ::pass("... handler was called") } } @ARGV = (); my $e = FCGI::Engine->new_with_options(handler_class => 'Foo'); isa_ok($e, 'FCGI::Engine'); isa_ok($e, 'FCGI::Engine::Core'); does_ok($e, 'MooseX::Getopt'); ok(!$e->is_listening, '... we are not listening'); is($e->nproc, 1, '... we have the default 1 proc (but we are not using it)'); ok(!$e->has_pidfile, '... we have no pidfile'); ok(!$e->should_detach, '... we shouldnt daemonize'); is($e->manager, 'FCGI::Engine::ProcManager', '... we have the default manager (FCGI::Engine::ProcManager)'); ok(!$e->has_pre_fork_init, '... we dont have any pre-fork-init'); is($e->handler_class, 'Foo', '... we have a handler class'); is($e->handler_method, 'handler', '... we have our default handler method'); my $handler_args_builder = $e->handler_args_builder; is(ref $handler_args_builder, 'CODE', '... default handler args is an CODE ref'); my $handler_args = [ $handler_args_builder->() ]; isa_ok($handler_args->[0], 'CGI::Simple', '... default arg isa CGI::Simple'); eval { $e->run }; ok(!$@, '... we ran the handler okay'); FCGI-Engine-0.22/t/002_basic_with_listen.t000644 000765 000024 00000003603 12376445246 020535 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 17; use Test::Moose; use Cwd; use File::Spec::Functions; BEGIN { use_ok('FCGI::Engine'); } my $CWD = Cwd::cwd; $ENV{MX_DAEMON_STDOUT} = catfile($CWD, 'Out.txt'); $ENV{MX_DAEMON_STDERR} = catfile($CWD, 'Err.txt'); { package Foo; sub handler { "Foo::handler was called (but no one will ever see this)"; } } my $SOCKET = '/tmp/002_basic_with_listen.socket'; my $PIDFILE = '/tmp/002_basic_with_listen.pid'; @ARGV = ( '--listen' => $SOCKET, '--pidfile' => $PIDFILE, '--daemon' ); my $e = FCGI::Engine->new_with_options(handler_class => 'Foo'); isa_ok($e, 'FCGI::Engine'); does_ok($e, 'MooseX::Getopt'); ok($e->is_listening, '... we are listening'); is($e->listen, $SOCKET, '... we have the right socket location'); is($e->nproc, 1, '... we have the default 1 proc'); ok($e->has_pidfile, '... we have a pidfile'); isa_ok($e->pidfile, 'MooseX::Daemonize::Pid::File'); is($e->pidfile->file, $PIDFILE, '... we have the right pidfile'); ok($e->should_detach, '... we should daemonize'); is($e->manager, 'FCGI::Engine::ProcManager', '... we have the default manager (FCGI::ProcManager)'); ok(!$e->has_pre_fork_init, '... we dont have any pre-fork-init'); unless ( fork ) { $e->run; exit; } else { sleep(1); # 1 seconds should be enough for everything to happen ok(-S $SOCKET, '... our socket was created'); ok(-f $PIDFILE, '... our pidfile was created'); my $pid = $e->pidfile; isa_ok($pid, 'MooseX::Daemonize::Pid::File'); ok($pid->is_running, '... our daemon is running (pid: ' . $pid->pid . ')'); kill TERM => $pid->pid; sleep(1); # give is a moment to die ... ok(!$pid->is_running, '... our daemon is no longer running (pid: ' . $pid->pid . ')'); unlink $SOCKET; } unlink $ENV{MX_DAEMON_STDOUT}; unlink $ENV{MX_DAEMON_STDERR}; FCGI-Engine-0.22/t/003_basic_with_options.t000644 000765 000024 00000003112 12376445246 020726 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 16; use Test::Moose; BEGIN { use_ok('FCGI::Engine'); } { package Foo; sub dispatcher { if (@_ == 3 && $_[0] eq 'Foo' && $_[1] eq 'q') { ::pass("... dispatcher was called"); } else { ::fail("... dispatcher was called with wrong args"); } } } @ARGV = (); my $e = FCGI::Engine->new_with_options( handler_class => 'Foo', handler_method => 'dispatcher', handler_args_builder => sub { (q => CGI::Simple->new) }, nproc => 10, ); isa_ok($e, 'FCGI::Engine'); does_ok($e, 'MooseX::Getopt'); ok(!$e->is_listening, '... we are not listening'); is($e->nproc, 10, '... we have the default 1 proc (but we are not using it)'); ok(!$e->has_pidfile, '... we have no pidfile'); ok(!$e->should_detach, '... we shouldnt daemonize'); is($e->manager, 'FCGI::Engine::ProcManager', '... we have the default manager (FCGI::Engine::ProcManager)'); ok(!$e->has_pre_fork_init, '... we dont have any pre-fork-init'); is($e->handler_class, 'Foo', '... we have a handler class'); is($e->handler_method, 'dispatcher', '... we have our default handler method'); my $handler_args_builder = $e->handler_args_builder; is(ref $handler_args_builder, 'CODE', '... default handler args is an CODE ref'); my $handler_args = [ $handler_args_builder->() ]; is($handler_args->[0], 'q', '... got our right default arg'); isa_ok($handler_args->[1], 'CGI::Simple', '... default arg isa CGI::Simple'); eval { $e->run }; ok(!$@, '... we ran the handler okay'); FCGI-Engine-0.22/t/004_basic_psgi.t000644 000765 000024 00000002524 12376445246 017151 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; BEGIN { { local $@; eval "use Plack;"; plan skip_all => "Plack is required for this test" if $@; } { local $@; eval "use IO::String;"; plan skip_all => "IO::String is required for this test" if $@; } plan tests => 13; use_ok('FCGI::Engine::PSGI'); } my $app = sub { [ 200, [ 'Content-type' => 'text/html' ], [ 'Hello World' ] ]; }; @ARGV = (); my $e = FCGI::Engine::PSGI->new_with_options( app => $app ); isa_ok($e, 'FCGI::Engine::PSGI'); isa_ok($e, 'FCGI::Engine::Core'); does_ok($e, 'MooseX::Getopt'); ok(!$e->is_listening, '... we are not listening'); is($e->nproc, 1, '... we have the default 1 proc (but we are not using it)'); ok(!$e->has_pidfile, '... we have no pidfile'); ok(!$e->should_detach, '... we shouldnt daemonize'); is($e->manager, 'FCGI::Engine::ProcManager', '... we have the default manager (FCGI::Engine::ProcManager)'); ok(!$e->has_pre_fork_init, '... we dont have any pre-fork-init'); is($e->app, $app, '... and it is our app'); my $var; eval { tie *STDOUT, 'IO::String' => $var; $e->run; untie( *STDOUT ); }; ok(!$@, '... we ran the handler okay') || warn $@; is($var, "Status: 200\r\nContent-type: text/html\r\n\r\nHello World", '... got the expect output too'); FCGI-Engine-0.22/t/010_errors.t000644 000765 000024 00000002152 12376445246 016354 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 7; use Test::Exception; use Test::Moose; BEGIN { use_ok('FCGI::Engine'); } { package Foo; sub handler { ::pass("... handler was called") } } @ARGV = (); dies_ok { FCGI::Engine->new_with_options; } '... cant build class with out handler_class'; # dies_ok { # FCGI::Engine->new_with_options( # handler_class => 'Foo', # handler_method => 'run' # ); # } '... cant have a handler method which is not supported by the handler class'; { my $e = FCGI::Engine->new_with_options(handler_class => 'Foo'); isa_ok($e, 'FCGI::Engine'); dies_ok { $e->pid_obj } '... cannot get a pid object if there is no pidfile specified'; } @ARGV = ('--listen', '/tmp/foo.socket'); dies_ok { FCGI::Engine->new_with_options(handler_class => 'Foo'); } '... cant have socket but not pidfile'; push @ARGV => ('--pidfile', '/tmp/foo.pid'); { my $e = FCGI::Engine->new_with_options(handler_class => 'Foo'); isa_ok($e, 'FCGI::Engine'); ok($e->has_pidfile, '... we have a pidfile specified'); } FCGI-Engine-0.22/t/020_basic_manager.t000644 000765 000024 00000004451 12376445246 017620 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use Cwd; use File::Spec::Functions; use Test::More; use Test::Exception; use Test::Moose; BEGIN { my $got_YAML = 1; eval "use YAML::XS;"; $got_YAML = 0 if $@; plan skip_all => "Some kind of YAML parser is required for this test" unless $got_YAML; plan tests => 19; use_ok('FCGI::Engine::Manager'); } my $CWD = Cwd::cwd; $ENV{MX_DAEMON_STDOUT} = catfile($CWD, 'Out.txt'); $ENV{MX_DAEMON_STDERR} = catfile($CWD, 'Err.txt'); my $m = FCGI::Engine::Manager->new( conf => catfile($FindBin::Bin, 'confs', 'test_conf.yml') ); isa_ok($m, 'FCGI::Engine::Manager'); does_ok($m, 'MooseX::Getopt'); lives_ok { $m->start; } '... started okay'; #diag join "\n" => map { chomp; s/\s+$//; $_ } grep { /fcgi|overseer|minion/ } `ps auxwww`; is( $m->status, "foo.server is running\nbar.server is running\n", '... got the right status' ); lives_ok { $m->stop; } '... stopped okay'; is( $m->status, "foo.server is not running\nbar.server is not running\n", '... got the right status' ); # ... now try loading just a single server ... (make sure everything is cleaned up right) lives_ok { $m->start('foo.server'); } '... started okay'; is( $m->status('foo.server'), "foo.server is running\n", '... got the right status' ); is( $m->status('bar.server'), "bar.server is not running\n", '... got the right status' ); #diag join "\n" => map { chomp; s/\s+$//; $_ } grep { /fcgi|overseer|minion/ } `ps auxwww`; lives_ok { $m->stop('foo.server'); } '... stopped okay'; is( $m->status('foo.server'), "foo.server is not running\n", '... got the right status' ); is( $m->status('bar.server'), "bar.server is not running\n", '... got the right status' ); # ... now try starting, restarting and then stopping again ... lives_ok { $m->start('foo.server'); } '... started okay'; is( $m->status('foo.server'), "foo.server is running\n", '... got the right status' ); lives_ok { $m->restart('foo.server'); } '... restarted okay'; is( $m->status('foo.server'), "foo.server is running\n", '... got the right status' ); lives_ok { $m->stop('foo.server'); } '... stopped okay'; is( $m->status('foo.server'), "foo.server is not running\n", '... got the right status' ); unlink $ENV{MX_DAEMON_STDOUT}; unlink $ENV{MX_DAEMON_STDERR}; FCGI-Engine-0.22/t/021_manager_opts.t000644 000765 000024 00000003670 12376445246 017527 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use Cwd; use File::Spec::Functions; use Test::More; use Test::Exception; use Test::Moose; BEGIN { my $got_YAML = 1; eval "use YAML::XS;"; $got_YAML = 0 if $@; plan skip_all => "Some kind of YAML parser is required for this test" unless $got_YAML; plan tests => 15; use_ok('FCGI::Engine::Manager'); } my $CWD = Cwd::cwd; $ENV{MX_DAEMON_STDOUT} = catfile($CWD, 'Out.txt'); $ENV{MX_DAEMON_STDERR} = catfile($CWD, 'Err.txt'); my $m = FCGI::Engine::Manager->new( conf => catfile($FindBin::Bin, 'confs', 'test_conf.yml') ); isa_ok($m, 'FCGI::Engine::Manager'); does_ok($m, 'MooseX::Getopt'); lives_ok { $m->start('foo.server'); } '... started foo server okay'; is( $m->status, "foo.server is running\nbar.server is not running\n", '... got the right status' ); lives_ok { $m->start('bar.server'); } '... started bar server okay'; is( $m->status, "foo.server is running\nbar.server is running\n", '... got the right status' ); #diag join "\n" => map { chomp; s/\s+$//; $_ } grep { /fcgi|overseer|minion/ } `ps auxwww`; lives_ok { $m->stop(); } '... stopped all okay'; is( $m->status, "foo.server is not running\nbar.server is not running\n", '... got the right status' ); ## now reverse that ... lives_ok { $m->start(); } '... started all okay'; is( $m->status, "foo.server is running\nbar.server is running\n", '... got the right status' ); lives_ok { $m->stop('foo.server'); } '... stopped foo server okay'; is( $m->status, "foo.server is not running\nbar.server is running\n", '... got the right status' ); lives_ok { $m->stop('bar.server'); } '... stopped bar server okay'; is( $m->status, "foo.server is not running\nbar.server is not running\n", '... got the right status' ); #diag join "\n" => map { chomp; s/\s+$//; $_ } grep { /fcgi|overseer|minion/ } `ps auxwww`; unlink $ENV{MX_DAEMON_STDOUT}; unlink $ENV{MX_DAEMON_STDERR}; FCGI-Engine-0.22/t/022_more_manager_opts.t000644 000765 000024 00000002042 12376445246 020542 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use Cwd; use File::Spec::Functions; use Test::More; use Test::Exception; use Test::Moose; BEGIN { my $got_YAML = 1; eval "use YAML::XS;"; $got_YAML = 0 if $@; plan skip_all => "Some kind of YAML parser is required for this test" unless $got_YAML; plan tests => 6; use_ok('FCGI::Engine::Manager'); } my $CWD = Cwd::cwd; $ENV{MX_DAEMON_STDOUT} = catfile($CWD, 'Out.txt'); $ENV{MX_DAEMON_STDERR} = catfile($CWD, 'Err.txt'); my $m = FCGI::Engine::Manager->new( conf => catfile($FindBin::Bin, 'confs', 'test_conf.yml') ); isa_ok($m, 'FCGI::Engine::Manager'); does_ok($m, 'MooseX::Getopt'); lives_ok { $m->start(); } '... started all okay'; #diag join "\n" => map { chomp; s/\s+$//; $_ } grep { /fcgi|overseer|minion/ } `ps auxwww`; lives_ok { $m->restart('foo.server'); } '... stopped foo server okay'; lives_ok { $m->stop(); } '... stopped all okay'; ## now reverse that ... unlink $ENV{MX_DAEMON_STDOUT}; unlink $ENV{MX_DAEMON_STDERR}; FCGI-Engine-0.22/t/023_manager_w_plackup.t000644 000765 000024 00000004056 12376445246 020530 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use Cwd; use File::Spec::Functions; use Test::More; use Test::Exception; use Test::Moose; BEGIN { my $got_YAML = 1; eval "use YAML::XS;"; $got_YAML = 0 if $@; plan skip_all => "Some kind of YAML parser is required for this test" unless $got_YAML; { local $@; eval "use Plack 0.9910; use FCGI::Client 0.04; use MooseX::NonMoose 0.07; use IO::String;"; plan skip_all => "Plack 0.9910, FCGI::Client and MooseX::NonMoose are required for this test" if $@; } { my $plackup_found = 0; if (eval { require File::Which; 1 }) { $plackup_found = 1 if (File::Which::which('plackup')); } else { $plackup_found = 1 if length(`which plackup`); } plan skip_all => 'plackup must be in $PATH' unless $plackup_found; } plan tests => 11; use_ok('FCGI::Engine::Manager'); } my $CWD = Cwd::cwd; $ENV{MX_DAEMON_STDOUT} = catfile($CWD, 'Out.txt'); $ENV{MX_DAEMON_STDERR} = catfile($CWD, 'Err.txt'); my $m = FCGI::Engine::Manager->new( conf => catfile($FindBin::Bin, 'confs', 'test_plack_conf.yml') ); isa_ok($m, 'FCGI::Engine::Manager'); does_ok($m, 'MooseX::Getopt'); lives_ok { $m->start('baz.server'); } '... started baz server okay'; is( $m->status, "baz.server is running\n", '... got the right status' ); #diag join "\n" => map { chomp; s/\s+$//; $_ } grep { /fcgi|overseer|minion/ } `ps auxwww`; lives_ok { $m->stop(); } '... stopped all okay'; is( $m->status, "baz.server is not running\n", '... got the right status' ); ## now reverse that ... lives_ok { $m->start(); } '... started all okay'; is( $m->status, "baz.server is running\n", '... got the right status' ); lives_ok { $m->stop('baz.server'); } '... stopped baz server okay'; is( $m->status, "baz.server is not running\n", '... got the right status' ); #diag join "\n" => map { chomp; s/\s+$//; $_ } grep { /fcgi|overseer|minion/ } `ps auxwww`; unlink $ENV{MX_DAEMON_STDOUT}; unlink $ENV{MX_DAEMON_STDERR}; FCGI-Engine-0.22/t/024_manager_wo_listen.t000644 000765 000024 00000003235 12376445246 020545 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 12; use Test::Moose; BEGIN { use_ok('FCGI::Engine'); } { package Foo; sub handler { ::pass("... handler was called") } } { package Foo::Manager; use Moose; extends qw(FCGI::Engine::ProcManager); our @CALLSTACK = (); sub manage { push @CALLSTACK, 'manage'; } } { @Foo::Manager::CALLSTACK = (); my $e = FCGI::Engine->new_with_options( handler_class => 'Foo', manager => 'Foo::Manager', ); is( $e->nproc, 1, '... we have the default 1 proc' ); is( $e->manager, 'Foo::Manager', '... we have the custom manager (Foo::Manager)' ); is( $e->use_manager, 0, '... we have the default value 0 for use_manager attribute' ); eval { $e->run }; ok( !$@, '... we ran the handler okay' ); is( scalar(@Foo::Manager::CALLSTACK), 0, '... having 1 proc does not use the Manager' ); } { @Foo::Manager::CALLSTACK = (); my $e = FCGI::Engine->new_with_options( handler_class => 'Foo', manager => 'Foo::Manager', nproc => 2, pidfile => '/tmp/024_manager_wo_listen.pid', use_manager => 1 ); is( $e->nproc, 2, '... we have the custom 2 proc' ); is( $e->manager, 'Foo::Manager', '... we have the custom manager (Foo::Manager)' ); is( $e->use_manager, 1, '... we have the custom value 1 for use_manager attribute' ); eval { $e->run }; ok( !$@, '... we ran the handler okay' ); is_deeply( \@Foo::Manager::CALLSTACK, [qw(manage)], '... having more than 2 procs uses the Manager' ); } FCGI-Engine-0.22/t/030_proc_manager.t000644 000765 000024 00000002057 12376445246 017503 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 6; use FCGI::Engine::ProcManager; my $m; ok $m = FCGI::Engine::ProcManager->new(); ok $m->n_processes() == 0; ok $m->n_processes(100) == 100; ok $m->n_processes(2) == 2; ok $m->n_processes(0) == 0; ok !$m->manage(); #ok $m->n_processes(-3); #eval { $m->manage(); }; #ok $@ =~ /dying from number of processes exception: -3/; #undef $@; if ($ENV{PM_N_PROCESSES}) { $m->n_processes($ENV{PM_N_PROCESSES}); $m->manage(); sample_request_loop($m); } exit 0; sub sample_request_loop { my ($m) = @_; while (1) { # Simulate blocking for a request. my $t1 = int(rand(2)+2); print "TEST: simulating blocking for request: $t1 seconds.\n"; sleep $t1; # (Here is where accept-fail-on-intr would exit request loop.) $m->pre_dispatch(); # Simulate a request dispatch. my $t = int(rand(3)+2); print "TEST: simulating new request: $t seconds.\n"; while (my $nslept = sleep $t) { $t -= $nslept; last unless $t; } $m->post_dispatch(); } } FCGI-Engine-0.22/t/050_lighttpd_basic_test.t000644 000765 000024 00000004732 12376445246 021071 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use Test::WWW::Mechanize; use Test::Moose; use t::lib::utils; my $lighttpd; BEGIN { $lighttpd = utils::find_lighttpd(); plan skip_all => "A lighttpd binary must be available for this test" unless $lighttpd; plan tests => 27; use_ok('FCGI::Engine'); } use Cwd; use File::Spec::Functions; my $CWD = Cwd::cwd; $ENV{MX_DAEMON_STDOUT} = catfile($CWD, 'Out.txt'); $ENV{MX_DAEMON_STDERR} = catfile($CWD, 'Err.txt'); { package Counter; use Moose; my $count = 0; sub handler { print("Content-type: text/html\r\n\r\n"); print(++$count); } } my $SOCKET = '/tmp/050_lighttpd_basic_test.socket'; my $PIDFILE = '/tmp/050_lighttpd_basic_test.pid'; @ARGV = ( '--listen' => $SOCKET, '--pidfile' => $PIDFILE, '--daemon' ); my $e = FCGI::Engine->new_with_options(handler_class => 'Counter'); isa_ok($e, 'FCGI::Engine'); does_ok($e, 'MooseX::Getopt'); ok($e->is_listening, '... we are listening'); is($e->listen, $SOCKET, '... we have the right socket location'); is($e->nproc, 1, '... we have the default 1 proc'); ok($e->has_pidfile, '... we have a pidfile'); isa_ok($e->pidfile, 'MooseX::Daemonize::Pid::File'); is($e->pidfile->file, $PIDFILE, '... we have the right pidfile'); ok($e->should_detach, '... we should daemonize'); is($e->manager, 'FCGI::Engine::ProcManager', '... we have the default manager (FCGI::ProcManager)'); ok(!$e->has_pre_fork_init, '... we dont have any pre-fork-init'); unless ( fork ) { $e->run; exit; } else { sleep(1); # 1 seconds should be enough for everything to happen ok(-S $SOCKET, '... our socket was created'); ok(-f $PIDFILE, '... our pidfile was created'); my $pid = $e->pidfile; isa_ok($pid, 'MooseX::Daemonize::Pid::File'); ok($pid->is_running, '... our daemon is running (pid: ' . $pid->pid . ')'); utils::start_lighttpd('t/lighttpd_confs/050_lighttpd_basic_test.conf'); my $mech = Test::WWW::Mechanize->new; for (1 .. 5) { $mech->get_ok('http://localhost:3333/count', '... got the page okay'); $mech->content_is($_, '... got the content we expected'); } utils::stop_lighttpd(); kill TERM => $pid->pid; sleep(1); # give is a moment to die ... ok(!$pid->is_running, '... our daemon is no longer running (pid: ' . $pid->pid . ')'); unlink $SOCKET; } unlink $ENV{MX_DAEMON_STDOUT}; unlink $ENV{MX_DAEMON_STDERR}; FCGI-Engine-0.22/t/051_lighttpd_basic_tcp_test.t000644 000765 000024 00000004713 12376445246 021737 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use Test::WWW::Mechanize; use Test::Moose; use t::lib::utils; my $lighttpd; BEGIN { $lighttpd = utils::find_lighttpd(); plan skip_all => "A lighttpd binary must be available for this test" unless $lighttpd; plan tests => 27; use_ok('FCGI::Engine'); } use Cwd; use File::Spec::Functions; my $CWD = Cwd::cwd; $ENV{MX_DAEMON_STDOUT} = catfile($CWD, 'Out.txt'); $ENV{MX_DAEMON_STDERR} = catfile($CWD, 'Err.txt'); { package Counter; use Moose; my $count = 0; sub handler { print("Content-type: text/html\r\n\r\n"); print(++$count); } } my $SOCKET = ':10001'; my $PIDFILE = '/tmp/051_lighttpd_basic_tcp_test.pid'; @ARGV = ( '--listen' => $SOCKET, '--pidfile' => $PIDFILE, '--daemon' ); my $e = FCGI::Engine->new_with_options(handler_class => 'Counter'); isa_ok($e, 'FCGI::Engine'); does_ok($e, 'MooseX::Getopt'); ok($e->is_listening, '... we are listening'); is($e->listen, $SOCKET, '... we have the right socket location'); ok(!Scalar::Util::blessed($e->listen), '... this is a socket, not a Path::Class::File'); is($e->nproc, 1, '... we have the default 1 proc'); ok($e->has_pidfile, '... we have a pidfile'); isa_ok($e->pidfile, 'MooseX::Daemonize::Pid::File'); is($e->pidfile->file, $PIDFILE, '... we have the right pidfile'); ok($e->should_detach, '... we should daemonize'); is($e->manager, 'FCGI::Engine::ProcManager', '... we have the default manager (FCGI::ProcManager)'); ok(!$e->has_pre_fork_init, '... we dont have any pre-fork-init'); unless ( fork ) { $e->run; exit; } else { sleep(1); # 1 seconds should be enough for everything to happen ok(-f $PIDFILE, '... our pidfile was created'); my $pid = $e->pidfile; isa_ok($pid, 'MooseX::Daemonize::Pid::File'); ok($pid->is_running, '... our daemon is running (pid: ' . $pid->pid . ')'); utils::start_lighttpd('t/lighttpd_confs/051_lighttpd_basic_tcp_test.conf'); my $mech = Test::WWW::Mechanize->new; for (1 .. 5) { $mech->get_ok('http://localhost:3333/count', '... got the page okay'); $mech->content_is($_, '... got the content we expected'); } utils::stop_lighttpd(); kill TERM => $pid->pid; sleep(1); # give is a moment to die ... ok(!$pid->is_running, '... our daemon is no longer running (pid: ' . $pid->pid . ')'); unlink $SOCKET; } unlink $ENV{MX_DAEMON_STDOUT}; unlink $ENV{MX_DAEMON_STDERR}; FCGI-Engine-0.22/t/100_plack_server_fcgi_engine.t000644 000765 000024 00000002427 12376445246 022042 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use Test::More; BEGIN { { local $@; eval "use Plack 0.9910; use FCGI::Client 0.04; use MooseX::NonMoose 0.07; use IO::String;"; plan skip_all => "Plack 0.9910, FCGI::Client and MooseX::NonMoose are required for this test" if $@; } } use Test::TCP; use Plack::Handler::FCGI::Engine; use Plack::Test::Suite; use t::lib::FCGIUtils; my $lighty_port; my $fcgi_port; test_lighty_external( sub { ($lighty_port, $fcgi_port, my $needs_fix) = @_; Plack::Test::Suite->run_server_tests(run_server_cb($needs_fix), $fcgi_port, $lighty_port); done_testing(); } ); sub run_server_cb { my $needs_fix = shift; require Plack::Middleware::LighttpdScriptNameFix; return sub { my($port, $app) = @_; note "Applying LighttpdScriptNameFix" if $needs_fix; $app = Plack::Middleware::LighttpdScriptNameFix->wrap($app) if $needs_fix; $| = 0; # Test::Builder autoflushes this. reset! my $server = Plack::Handler::FCGI::Engine->new( host => '127.0.0.1', port => $port, pidfile => '/tmp/100_plack_server_fcgi_engine.pid', keep_stderr => 1, ); $server->run($app); }; } FCGI-Engine-0.22/t/101_plack_server_fcgi_engine_client.t000644 000765 000024 00000002036 12376445246 023375 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use Test::More; BEGIN { { local $@; eval "use Plack 0.9910; use FCGI::Client 0.06; use MooseX::NonMoose 0.07; use IO::String; use Plack::App::FCGIDispatcher;"; plan skip_all => "Plack 0.9910, FCGI::Client 0.06, MooseX::NonMoose 0.07 and Plack::App::FCGIDispatcher are required for this test" if $@; } } use Plack::Handler::FCGI::Engine; use Test::TCP; use Plack::Test::Suite; use t::lib::FCGIUtils; my $http_port; my $fcgi_port; test_fcgi_standalone( sub { ($http_port, $fcgi_port) = @_; Plack::Test::Suite->run_server_tests(\&run_server, $fcgi_port, $http_port); done_testing(); } ); sub run_server { my($port, $app) = @_; $| = 0; # Test::Builder autoflushes this. reset! my $server = Plack::Handler::FCGI::Engine->new( host => '127.0.0.1', port => $port, pidfile => '/tmp/101_plack_server_fcgi_engine_client.pid', keep_stderr => 1, ); $server->run($app); } FCGI-Engine-0.22/t/102_plack_server_fcgi_compat.t000644 000765 000024 00000002361 12376445246 022057 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use Test::More; BEGIN { { local $@; eval "use Plack 0.9910; use FCGI::Client 0.04; use MooseX::NonMoose 0.07; use IO::String;"; plan skip_all => "Plack 0.9910, FCGI::Client and MooseX::NonMoose are required for this test" if $@; } } use Plack::Handler::FCGI::Engine; use Test::TCP; use Plack::Test::Suite; use t::lib::FCGIUtils; my $lighty_port; my $fcgi_port; test_lighty_external( sub { ($lighty_port, $fcgi_port, my $needs_fix) = @_; Plack::Test::Suite->run_server_tests(run_server_cb($needs_fix), $fcgi_port, $lighty_port); done_testing(); } ); sub run_server_cb { my $needs_fix = shift; require Plack::Middleware::LighttpdScriptNameFix; return sub { my($port, $app) = @_; note "Applying LighttpdScriptNameFix" if $needs_fix; $app = Plack::Middleware::LighttpdScriptNameFix->wrap($app) if $needs_fix; $| = 0; # Test::Builder autoflushes this. reset! my $server = Plack::Handler::FCGI::Engine->new( host => '127.0.0.1', port => $port, manager => '', keep_stderr => 1, ); $server->run($app); }; } FCGI-Engine-0.22/t/confs/000755 000765 000024 00000000000 12376456042 015377 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/t/lib/000755 000765 000024 00000000000 12376456042 015035 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/t/lighttpd_confs/000755 000765 000024 00000000000 12376456042 017276 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/t/pod.t000644 000765 000024 00000000257 12376445246 015246 0ustar00stevanstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); FCGI-Engine-0.22/t/scripts/000755 000765 000024 00000000000 12376456042 015756 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/t/scripts/bar.pl000644 000765 000024 00000000375 12376445246 017070 0ustar00stevanstaff000000 000000 #!perl use strict; use warnings; use FindBin; use File::Spec::Functions; use lib catdir($FindBin::Bin, updir, updir, 'lib'); use FCGI::Engine; { package Bar; sub handler { () } } FCGI::Engine->new_with_options(handler_class => 'Bar')->run;FCGI-Engine-0.22/t/scripts/baz.psgi000644 000765 000024 00000000214 12376445246 017417 0ustar00stevanstaff000000 000000 #!perl use strict; use warnings; my $app = sub { my $env = shift; [ 200, [ 'Content-type' => 'text/plain' ], [ 'hello world' ]] };FCGI-Engine-0.22/t/scripts/foo.pl000644 000765 000024 00000000360 12376445246 017101 0ustar00stevanstaff000000 000000 #!perl use strict; use warnings; use FCGI::Engine; { package Foo; sub handler { () } } FCGI::Engine->new_with_options(handler_class => 'Foo')->run( process_name => 'minion', manager_process_name => 'overseer', );FCGI-Engine-0.22/t/lighttpd_confs/050_lighttpd_basic_test.conf000644 000765 000024 00000000312 12376445246 024550 0ustar00stevanstaff000000 000000 include "fcgi_engine.lighttpd.base.conf" fastcgi.server = ( "/count" => (( "check-local" => "disable", "socket" => "/tmp/050_lighttpd_basic_test.socket", )) ) FCGI-Engine-0.22/t/lighttpd_confs/051_lighttpd_basic_tcp_test.conf000644 000765 000024 00000000310 12376445246 025415 0ustar00stevanstaff000000 000000 include "fcgi_engine.lighttpd.base.conf" fastcgi.server = ( "/count" => (( "check-local" => "disable", "host" => "127.0.0.1", "port" => 10001, )) ) FCGI-Engine-0.22/t/lighttpd_confs/fcgi_engine.lighttpd.base.conf000644 000765 000024 00000000211 12376445246 025127 0ustar00stevanstaff000000 000000 server.modules = ("mod_fastcgi") server.document-root = "/tmp/" server.pid-file = "/tmp/lighttpd.pid" server.port = 3333 FCGI-Engine-0.22/t/lib/FCGIUtils.pm000644 000765 000024 00000006132 12376445246 017132 0ustar00stevanstaff000000 000000 package t::lib::FCGIUtils; use strict; use warnings; use File::Temp (); use FindBin; use Test::More; use IO::Socket; use File::Spec; use Test::TCP qw/test_tcp empty_port/; use parent qw/Exporter/; # this file is copied from Catalyst. thanks! our @EXPORT = qw/ test_lighty_external test_fcgi_standalone /; # TODO: tesst for .fcgi sub test_lighty_fcgi { } # test using FCGI::Client + FCGI External Server sub test_fcgi_standalone { my ($callback, $http_port, $fcgi_port) = @_; $http_port ||= empty_port(); $fcgi_port ||= empty_port($http_port); require Plack::App::FCGIDispatcher; my $fcgi_app = Plack::App::FCGIDispatcher->new({ port => $fcgi_port })->to_app; test_tcp( server => sub { my $server = Plack::Loader->load('Standalone', host => '127.0.0.1', port => $http_port); $server->run($fcgi_app); }, client => sub { $callback->($http_port, $fcgi_port); }, port => $http_port, ); } # test for FCGI External Server sub test_lighty_external (&@) { my ($callback, $lighty_port, $fcgi_port) = @_; $lighty_port ||= empty_port(); $fcgi_port ||= empty_port($lighty_port); my $lighttpd_bin = $ENV{LIGHTTPD_BIN} || `which lighttpd`; chomp $lighttpd_bin; plan skip_all => 'Please set LIGHTTPD_BIN to the path to lighttpd' unless $lighttpd_bin && -x $lighttpd_bin; my $ver = (`$lighttpd_bin -v` =~ m!lighttpd[-/]1.(\d+\.\d+)!)[0]; if ($ver < 4.17) { plan skip_all => "Too old lighttpd (1.$ver), known to be broken"; } diag "Testing with lighttpd 1.$ver"; my $tmpdir = File::Temp::tempdir( CLEANUP => 1 ); test_tcp( client => sub { $callback->($lighty_port, $fcgi_port, ($ver && $ver < 4.23)); warn `cat $tmpdir/error.log` if $ENV{DEBUG}; }, server => sub { my $conffname = File::Spec->catfile($tmpdir, "lighty.conf"); _write_file($conffname => _render_conf($tmpdir, $lighty_port, $fcgi_port)); my $pid = open my $lighttpd, "$lighttpd_bin -D -f $conffname 2>&1 |" or die "Unable to spawn lighttpd: $!"; $SIG{TERM} = sub { kill 'INT', $pid; close $lighttpd; exit; }; sleep 60; # waiting tests. die "server timeout"; }, port => $lighty_port, ); } sub _write_file { my ($fname, $src) = @_; open my $fh, '>', $fname or die $!; print {$fh} $src or die $!; close $fh; } sub _render_conf { my ($tmpdir, $port, $fcgiport) = @_; <<"END"; # basic lighttpd config file for testing fcgi(external server)+Plack server.modules += ("mod_fastcgi") server.document-root = "$tmpdir" server.bind = "127.0.0.1" server.port = $port # HTTP::Engine app specific fcgi setup fastcgi.server = ( "/" => (( "check-local" => "disable", "host" => "127.0.0.1", "port" => $fcgiport, "idle-timeout" => 20, "fix-root-scriptname" => "enable", # for 1.4.23 or later )) ) END } 1;FCGI-Engine-0.22/t/lib/utils.pm000644 000765 000024 00000001420 12376445246 016534 0ustar00stevanstaff000000 000000 package utils; use strict; use warnings; use Path::Class::File; sub find_lighttpd { my $lighttpd = map { chomp; $_ } `which lighttpd`; if ( ! -x "$lighttpd" ) { PREFIX: for my $prefix (qw(/usr /usr/local /opt/local /sw)) { for my $bindir (qw(bin sbin)) { $lighttpd="$prefix/$bindir/lighttpd"; last PREFIX if -x "$lighttpd" } } } return unless -x $lighttpd; return $lighttpd; } sub lighttpd_pidfile { Path::Class::File->new('/tmp/lighttpd.pid') } sub start_lighttpd { my $conf = shift; system(find_lighttpd(), '-f', $conf); } sub stop_lighttpd { my $signal = shift || 'TERM'; kill $signal => ((lighttpd_pidfile)->slurp(chomp => 1)); } 1; __END__ FCGI-Engine-0.22/t/confs/test_conf.yml000644 000765 000024 00000000612 12376445246 020111 0ustar00stevanstaff000000 000000 --- - name: "foo.server" server_class: "FCGI::Engine::Manager::Server" scriptname: "t/scripts/foo.pl" nproc: 1 pidfile: "/tmp/foo.pid" socket: "/tmp/foo.socket" additional_args: [ "-I", "lib/" ] - name: "bar.server" scriptname: "t/scripts/bar.pl" nproc: 1 pidfile: "/tmp/bar.pid" socket: "/tmp/bar.socket" FCGI-Engine-0.22/t/confs/test_plack_conf.yml000644 000765 000024 00000000346 12376445246 021267 0ustar00stevanstaff000000 000000 --- - name: "baz.server" server_class: "FCGI::Engine::Manager::Server::Plackup" scriptname: "t/scripts/baz.psgi" nproc: 1 pidfile: "/tmp/baz.pid" socket: "/tmp/baz.socket" FCGI-Engine-0.22/lib/FCGI/000755 000765 000024 00000000000 12376456042 015302 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/000755 000765 000024 00000000000 12376456042 015624 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/Handler/000755 000765 000024 00000000000 12376456042 017201 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/Server/000755 000765 000024 00000000000 12376456042 017072 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/Server/FCGI/000755 000765 000024 00000000000 12376456042 017602 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/Server/FCGI/Engine/000755 000765 000024 00000000000 12376456042 021007 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/Server/FCGI/Engine.pm000644 000765 000024 00000001473 12376454257 021360 0ustar00stevanstaff000000 000000 package Plack::Server::FCGI::Engine; use Moose; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'Plack::Handler::FCGI::Engine'; __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Plack::Server::FCGI::Engine - DEPRECATED use Plack::Handler::FCGI::Engine =head1 DESCRIPTION B use Plack::Handler::FCGI::Engine. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan.little@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2009-2010 Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/Plack/Server/FCGI/Engine/ProcManager.pm000644 000765 000024 00000001573 12376454255 023555 0ustar00stevanstaff000000 000000 package Plack::Server::FCGI::Engine::ProcManager; use Moose; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'Plack::Handler::FCGI::Engine::ProcManager'; __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Plack::Server::FCGI::Engine::ProcManager - DEPRECATED use Plack::Handler::FCGI::Engine::ProcManager =head1 DESCRIPTION B use Plack::Handler::FCGI::Engine::ProcManager =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan.little@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2009-2010 Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/Plack/Handler/FCGI/000755 000765 000024 00000000000 12376456042 017711 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/Handler/FCGI/Engine/000755 000765 000024 00000000000 12376456042 021116 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/Plack/Handler/FCGI/Engine.pm000644 000765 000024 00000002524 12376454261 021460 0ustar00stevanstaff000000 000000 package Plack::Handler::FCGI::Engine; use Moose; use MooseX::NonMoose; use Plack::Handler::FCGI::Engine::ProcManager; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'Plack::Handler::FCGI'; has 'manager' => ( is => 'ro', isa => 'Str | ClassName', default => sub { 'Plack::Handler::FCGI::Engine::ProcManager' }, ); __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Plack::Handler::FCGI::Engine - A Plack::Handler backend for FCGI::Engine =head1 SYNOPSIS use Plack::Handler::FCGI::Engine; my $handler = Plack::Handler::FCGI::Engine->new( nproc => $num_proc, listen => $listen, detach => 1, ); $handler->run($app); =head1 DESCRIPTION This is a subclass of L which will use the L process manager by default, instead of L. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan.little@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2009-2010 Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/Plack/Handler/FCGI/Engine/ProcManager.pm000644 000765 000024 00000002606 12376454260 023656 0ustar00stevanstaff000000 000000 package Plack::Handler::FCGI::Engine::ProcManager; use Moose; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'FCGI::Engine::ProcManager'; has 'pidfile' => ( init_arg => 'pid_fname', is => 'rw', isa => 'MooseX::Daemonize::Pid::File', coerce => 1, ); # FCGI::ProcManager compat sub pm_manage { (shift)->manage( @_ ) } sub pm_pre_dispatch { (shift)->pre_dispatch( @_ ) } sub pm_post_dispatch { (shift)->post_dispatch( @_ ) } sub notify { my ($self, $msg) = @_; $msg =~ s/\s*$/\n/; print STDERR "FastCGIEngine: " . $self->role() . " (pid $$): " . $msg; } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Plack::Handler::FCGI::Engine::ProcManager - A process manager for Plack::Handler::FCGI::Engine =head1 DESCRIPTION A subclass of L that is compatiable with L and L. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan.little@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2009-2010 Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/000755 000765 000024 00000000000 12376456042 016507 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/FCGI/Engine.pm000644 000765 000024 00000021150 12376455135 017046 0ustar00stevanstaff000000 000000 package FCGI::Engine; use Moose; use Class::Load (); use CGI::Simple; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'FCGI::Engine::Core'; has 'handler_class' => ( metaclass => 'NoGetopt', is => 'ro', isa => 'Str | Object', required => 1, ); has 'handler_method' => ( metaclass => 'NoGetopt', is => 'ro', isa => 'Str', default => sub { 'handler' }, ); has 'handler_args_builder' => ( metaclass => 'NoGetopt', is => 'ro', isa => 'CodeRef', default => sub { sub { CGI::Simple->new } }, ); augment 'initialize' => sub { my ( $self, %addtional_options ) = @_; my $handler_class = $self->handler_class; my $handler_method = $self->handler_method; my $handler_args = $self->handler_args_builder; Class::Load::load_class($handler_class) unless blessed $handler_class; ($self->handler_class->can($handler_method)) || confess "The handler class (" . $handler_class . ") does not support the handler method (" . $handler_method . ")"; }; sub create_environment { \%ENV } sub handle_request { my $self = shift; my $method = $self->handler_method; $self->handler_class->$method( $self->handler_args_builder->() ); } 1; __END__ =pod =head1 NAME FCGI::Engine - A flexible engine for running FCGI-based applications =head1 SYNOPSIS # in scripts/my_web_app_fcgi.pl use strict; use warnings; use FCGI::Engine; FCGI::Engine->new_with_options( handler_class => 'My::Web::Application', handler_method => 'run', pre_fork_init => sub { require('my_web_app_startup.pl'); } )->run; # run as normal FCGI script perl scripts/my_web_app_fcgi.pl # run as standalone FCGI server perl scripts/my_web_app_fcgi.pl --nproc 10 --pidfile /tmp/my_app.pid \ --listen /tmp/my_app.socket --daemon # see also FCGI::Engine::Manager for managing # multiple FastCGI backends under one script =head1 DESCRIPTION This module helps manage FCGI based web applications by providing a wrapper which handles most of the low-level FCGI details for you. It can run FCGI programs as simple scripts or as full standalone socket based servers who are managed by L. The code is largely based (*cough* stolen *cough*) on the L module, and provides a command line interface which is compatible with that module. But of course it does not require L or anything L related. So you can use this module with your L-based web application or any other L-based web app. =head2 Using with Catalyst, Plack or other web frameworks This module (FCGI::Engine) is B a replacement for L but instead the L (and all it's configuration tools) can be used to manager L apps as well as FCGI::Engine based applications. For example, at work we have an application which has 6 different FCGI backends running. Three of them use an ancient in-house web framework with simple FCGI::Engine wrappers, one which uses L and an FCGI::Engine wrapper and then two L applications. They all happily and peacefully coexist and are all managed with the same L script. As of version 0.11 we now have L/L applications support via the L module. See that module for more information about how it can be used. =head2 Note about CGI.pm usage This module uses L as a sane replacement for CGI.pm, it will pass in a L instance to your chosen C for you, so there is no need to create your own instance of it. There have been a few cases from users who have had bad interactions with CGI.pm and the instance of L we create for you, so before you spend hours looking for bugs in your app, check for this first instead. If you want to change this behavior and not use L then you can override this using the C option, see the docs on that below for more details. =head1 CAVEAT This module is *NIX B, it definitely does not work on Windows and I have no intention of making it do so. Sorry. =head1 PARAMETERS =head2 Command Line This module uses L for command line parameter handling and validation. All parameters are currently optional, but some parameters depend on one another. =over 4 =item I<--listen -l> This should be a file path where the unix domain socket file should live. If this parameter is specified, then you B also specify a location for the pidfile. =item I<--nproc -n> This should be an integer specifying the number of FCGI processes that L should start up. The default is 1. =item I<--pidfile -p> This should be a file path where your pidfile should live. This parameter is only used if the I parameter is specified. =item I<--daemon -d> This is a boolean parameter and has no argument, it is either used or not. It determines if the script should daemonize itself. This parameter only used if the I parameter is specified. =item I<--manager -m> This allows you to pass the name of a L subclass to use. The default is to use L, and any value passed to this parameter B be a subclass of L. =back =head2 Constructor In addition to the command line parameters, there are a couple parameters that the constuctor expects. =over 4 =item I This is expected to be a class name, which will be used inside the request loop to dispatch your web application. =item I This is the class method to be called on the I to server as a dispatch entry point to your web application. It will default to C. =item I This must be a CODE ref that when called produces the arguments to pass to the I. It defaults to a sub which returns a L object. =item I This is an optional CODE reference which will be executed prior to the request loop, and in a multi-proc context, prior to any forking (so as to take advantage of OS COW features). =back =head1 METHODS =head2 Command Line Related =over 4 =item B Returns the value passed on the command line with I<--listen>. This will return a L object. =item B A predicate used to determine if the I<--listen> parameter was specified. =item B Returns the value passed on the command line with I<--nproc>. =item B Returns the value passed on the command line with I<--pidfile>. This will return a L object. =item B A predicate used to determine if the I<--pidfile> parameter was specified. =item B Returns the value passed on the command line with I<--daemon>. =item B A predicate used to determine if the I<--daemon> parameter was specified. =item B Returns the value passed on the command line with I<--manager>. =back =head2 Inspection =over 4 =item B A predicate telling you if anything was passed to the I constructor parameter. =back =head2 Important Stuff =over 4 =item B Call this to start the show. It passes the C<%addtional_options> arguments to both the C sub and as constructor args to the C. =back =head2 Other Stuff =over 4 =item B This is the L BUILD method, it checks some of our parameters to be sure all is sane. =item B This returns the L metaclass assocaited with this class. =back =head1 SEE ALSO =over 4 =item L I took all the guts of that module and squished them around a bit and stuffed them in here. =item L =item L I refactored this module and renamed it L, which is now included in this distro. =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE Contributions from: Marcus Ramberg Bradley C. Bailey Brian Cassidy Johannes Plunien =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/Core.pm000644 000765 000024 00000013355 12376455155 017750 0ustar00stevanstaff000000 000000 package FCGI::Engine::Core; use Moose; use Class::Load (); use FCGI; use MooseX::Daemonize::Pid::File; use FCGI::Engine::Types; use FCGI::Engine::ProcManager; use constant DEBUG => 0; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; with 'MooseX::Getopt', 'MooseX::Daemonize::Core'; has 'listen' => ( metaclass => 'Getopt', is => 'ro', isa => 'FCGI::Engine::Listener', coerce => 1, cmd_aliases => 'l', predicate => 'is_listening', ); has 'nproc' => ( metaclass => 'Getopt', is => 'ro', isa => 'Int', default => sub { 1 }, cmd_aliases => 'n', ); has 'pidfile' => ( metaclass => 'Getopt', is => 'ro', isa => 'MooseX::Daemonize::Pid::File', coerce => 1, cmd_aliases => 'p', predicate => 'has_pidfile', ); has 'detach' => ( metaclass => 'Getopt', is => 'ro', isa => 'Bool', cmd_flag => 'daemon', cmd_aliases => 'd', predicate => 'should_detach', ); has 'manager' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str', default => sub { 'FCGI::Engine::ProcManager' }, cmd_aliases => 'M', ); has 'use_manager' => ( metaclass => 'Getopt', is => 'ro', isa => 'Bool', default => 0, ); # options to specify in your script has 'pre_fork_init' => ( metaclass => 'NoGetopt', is => 'ro', isa => 'CodeRef', predicate => 'has_pre_fork_init', ); ## methods ... sub BUILD { my $self = shift; ($self->has_pidfile) || confess "You must specify a pidfile if you are listening" if $self->is_listening; } sub initialize { my ( $self, %addtional_options ) = @_; $self->pre_fork_init->(%addtional_options) if $self->has_pre_fork_init; inner(); } sub create_socket { my $self = shift; my $socket = 0; if ($self->is_listening) { my $old_umask = umask; umask(0); $socket = FCGI::OpenSocket($self->listen, 100); umask($old_umask); } $socket; } sub create_environment { +{} } sub create_request { my ( $self, $socket, $env ) = @_; return FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, $env, $socket, &FCGI::FAIL_ACCEPT_ON_INTR ); } sub create_proc_manager { my ( $self, %addtional_options ) = @_; # make sure any subclasses are loaded ... Class::Load::load_class( $self->manager ); return $self->manager->new({ n_processes => $self->nproc, pidfile => $self->pidfile, %addtional_options }); } sub prepare_environment { my ($self, $_env) = @_; my $env = inner(); # Cargo-culted from Catalyst::Engine::FastCGI # and Plack::Server::FCGI, thanks guys :) if ( $env->{SERVER_SOFTWARE} ) { if ( $env->{SERVER_SOFTWARE} =~ /lighttpd/ ) { $env->{PATH_INFO} ||= delete $env->{SCRIPT_NAME}; $env->{SCRIPT_NAME} ||= ''; $env->{SERVER_NAME} =~ s/:\d+$//; # cut off port number } elsif ( $env->{SERVER_SOFTWARE} =~ /^nginx/ ) { my $script_name = $env->{SCRIPT_NAME}; $env->{PATH_INFO} =~ s/^$script_name//g; } } $env; } sub handle_request { confess __PACKAGE__ . " is abstract, override handle_request" } sub run { my ($self, %addtional_options) = @_; $self->initialize( %addtional_options ); my $socket = $self->create_socket; my $env = $self->create_environment; my $request = $self->create_request( $socket, $env ); my $proc_manager; if ($self->is_listening) { $self->daemon_fork && return if $self->detach; $proc_manager = $self->create_proc_manager( %addtional_options ); $self->daemon_detach( # Not sure we need this ... no_double_fork => 1, # we definetely need this ... dont_close_all_files => 1, ) if $self->detach; $proc_manager->manage; } # We do not listen but we do want more than one processes being forked and # want to take the benefit of running the process manager as well. This # makes sense if the FastCGI script is started directly via Apache. elsif ( $self->use_manager ) { $proc_manager = $self->create_proc_manager( %addtional_options ); $proc_manager->manage; } while ($request->Accept() >= 0) { $proc_manager && $proc_manager->pre_dispatch; $self->handle_request( $self->prepare_environment( $env ), $request ); $proc_manager && $proc_manager->post_dispatch; } } 1; __END__ =pod =head1 NAME FCGI::Engine::Core - A base class for various FCGI::Engine flavors =head1 DESCRIPTION This is a base class for various FCGI::Engine flavors, it should be possible to subclass this to add different approaches to FCGI::Engine. The basic L shows a Catalyst/CGI::Application style approach with a simple handler class, while the L shows how this can be used to run things like PSGI applications. This class is mostly of interest to other FCGI::Engine flavor developers, who should pretty much just read the source. The relevant docs are to be found in L and L. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/Manager/000755 000765 000024 00000000000 12376456042 020061 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/FCGI/Engine/Manager.pm000644 000765 000024 00000017473 12376455171 020435 0ustar00stevanstaff000000 000000 package FCGI::Engine::Manager; use Moose; use Class::Load (); use FCGI::Engine::Types; use FCGI::Engine::Manager::Server; use Config::Any; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; with 'MooseX::Getopt'; has 'conf' => ( is => 'ro', isa => 'Path::Class::File', coerce => 1, required => 1, ); has '_config' => ( is => 'ro', isa => 'FCGI::Engine::Manager::Config', lazy => 1, default => sub { my $self = shift; my $file = $self->conf->stringify; my $config = Config::Any->load_files({ files => [ $file ], use_ext => 1 })->[0]->{$file}; #use Data::Dumper; #warn Dumper $config; return $config; } ); has '_servers' => ( reader => 'servers', isa => 'ArrayRef[FCGI::Engine::Manager::Server]', lazy => 1, default => sub { my $self = shift; return [ map { $_->{server_class} ||= "FCGI::Engine::Manager::Server"; Class::Load::load_class($_->{server_class}); $_->{server_class}->new(%$_); } @{$self->_config} ]; }, ); sub log { shift; print @_, "\n" } sub start { my $self = shift; local $| = 1; $self->log("Starting up the FCGI servers ..."); my @servers = (@_ && defined $_[0]) ? $self->_find_server_by_name( @_ ) : @{ $self->servers }; foreach my $server ( @servers ) { if (-e $server->pidfile) { my $pid = $server->pid_obj; if ($pid->is_running) { $self->log("Pid " . $pid->pid . " is already running"); return; } $server->remove_pid_obj; } my @cli = $server->construct_command_line(); $self->log("Running @cli"); unless (system(@cli) == 0) { $self->log("Could not execute command (@cli) exited with status $?"); return; } my $count = 1; until (-e $server->pidfile) { $self->log("pidfile (" . $server->pidfile . ") does not exist yet ... (trying $count times)"); sleep 2; $count++; } my $pid = $server->pid_obj; while (!$pid->is_running) { $self->log("pid (" . $pid->pid . ") with pid_file (" . $server->pidfile . ") is not running yet, sleeping ..."); sleep 2; } $self->log("Pid " . $pid->pid . " is running"); } $self->log("... FCGI servers have been started"); } sub status { my $self = shift; my @servers = (@_ && defined $_[0]) ? $self->_find_server_by_name( @_ ) : @{ $self->servers }; my $status = ''; foreach my $server ( @servers ) { $status .= $server->name; if (! -f $server->pidfile ) { $status .= " is not running\n"; next; } my $pid = $server->pid_obj; $status .= $pid->is_running ? " is running\n" : " is not running\n" } return $status; } sub stop { my $self = shift; local $| = 1; $self->log("Killing the FCGI servers ..."); my @servers = (@_ && defined $_[0]) ? $self->_find_server_by_name( @_ ) : @{ $self->servers }; foreach my $server ( @servers ) { if (-f $server->pidfile) { my $pid = $server->pid_obj; $self->log("Killing PID " . $pid->pid . " from $$ "); kill TERM => $pid->pid; while ($pid->is_running) { $self->log("pid (" . $server->pidfile . ") is still running, sleeping ..."); sleep 1; } $server->pid_obj->remove; $server->remove_pid_obj; } if (-e $server->socket) { unlink($server->socket); } } $self->log("... FCGI servers have been killed"); } sub restart { my $self = shift; $self->stop( @_ ); sleep( 2 ); # give stop() some time $self->start( @_ ); } sub graceful { my $self = shift; my @servers = (@_ && defined $_[0]) ? $self->_find_server_by_name( @_ ) : @{ $self->servers }; my @pids; foreach my $server ( @servers ) { push @pids, $server->pid_obj->pid; unlink($server->pidfile); $server->remove_pid_obj; } $self->start( @_ ); foreach my $pid ( @pids ) { $self->log("... Killing old fcgi process $pid"); kill TERM => $pid; } foreach my $server ( @servers ) { while (-f $server->pidfile) { $self->log("pid (" . $server->pidfile . ") has not been removed, sleeping ..."); sleep 1; } $server->pid_obj->write; } } sub _find_server_by_name { my( $self, @names ) = @_; my %wanted = map { $_ => 1 } @names; my @servers = grep { exists $wanted{ $_->name } } @{ $self->servers }; return @servers; } 1; __END__ =pod =head1 NAME FCGI::Engine::Manager - Manage multiple FCGI::Engine instances =head1 SYNOPSIS #!/usr/bin/perl my $m = FCGI::Engine::Manager->new( conf => 'conf/my_app_conf.yml' ); my ($command, $server_name) = @ARGV; $m->start($server_name) if $command eq 'start'; $m->stop($server_name) if $command eq 'stop'; $m->restart($server_name) if $command eq 'restart'; $m->graceful($server_name) if $command eq 'graceful'; print $m->status($server_name) if $command eq 'status'; # on the command line perl all_my_fcgi_backends.pl start perl all_my_fcgi_backends.pl stop perl all_my_fcgi_backends.pl restart foo.server # etc ... =head1 DESCRIPTION This module handles multiple L instances for you, it can start, stop and provide basic status info. It is configurable using L, but only really the YAML format has been tested. =head2 Use with Catalyst Since L is pretty much compatible with L, this module can also be used to manage your L based apps as well as your L based apps. =head2 Use with Plack L support is provided via the L module. All that is required is setting the C parameter in the configuarion and it will Just Work. =head1 EXAMPLE CONFIGURATION Here is an example configuration in YAML, it should be noted that the options for each server are basically the constructor params to L and are passed verbatim to it. This means that if you subclass L and set the C option appropriately, it should pass any new options you added to your subclass automatically. The third server in the list shows exactly how this is used with a L application. --- - name: "foo.server" server_class: "FCGI::Engine::Manager::Server" scriptname: "t/scripts/foo.pl" nproc: 1 pidfile: "/tmp/foo.pid" socket: "/tmp/foo.socket" additional_args: [ "-I", "lib/" ] - name: "bar.server" scriptname: "t/scripts/bar.pl" nproc: 1 pidfile: "/tmp/bar.pid" socket: "/tmp/bar.socket" - name: "baz.server" server_class: "FCGI::Engine::Manager::Server::Plackup" scriptname: "t/scripts/baz.psgi" # the .psgi file nproc: 1 pidfile: "/tmp/baz.pid" socket: "/tmp/baz.socket" additional_args: [ "-E", "production" ] # plackup specific option =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/ProcManager/000755 000765 000024 00000000000 12376456042 020705 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/FCGI/Engine/ProcManager.pm000644 000765 000024 00000025412 12376454265 021254 0ustar00stevanstaff000000 000000 package FCGI::Engine::ProcManager; use Moose; use constant DEBUG => 0; use POSIX qw(SA_RESTART SIGTERM SIGHUP); use FCGI::Engine::Types; use MooseX::Daemonize::Pid::File; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; has 'role' => ( is => 'rw', isa => 'FCGI::Engine::ProcManager::Role', default => sub { 'manager' } ); has 'start_delay' => ( is => 'rw', isa => 'Int', default => sub { 0 } ); has 'die_timeout' => ( is => 'rw', isa => 'Int', default => sub { 60 } ); has 'n_processes' => ( is => 'rw', isa => 'Int', default => sub { 0 } ); has 'pidfile' => ( is => 'rw', isa => 'MooseX::Daemonize::Pid::File', # coerce => 1, ); has 'no_signals' => ( is => 'rw', isa => 'Bool', default => sub { 0 } ); has 'sigaction_no_sa_restart' => (is => 'rw', isa => 'POSIX::SigAction'); has 'sigaction_sa_restart' => (is => 'rw', isa => 'POSIX::SigAction'); has 'signals_received' => ( is => 'rw', isa => 'HashRef', default => sub { +{} } ); has 'manager_pid' => ( is => 'rw', isa => 'Int', ); has 'server_pids' => ( traits => [ 'Hash' ], is => 'rw', isa => 'HashRef', clearer => 'forget_all_pids', default => sub { +{} }, handles => { '_add_pid' => 'set', 'get_all_pids' => 'keys', 'remove_pid' => 'delete', 'has_pids' => 'count', 'pid_count' => 'count', } ); sub add_pid { (shift)->_add_pid( @_, 1 ) } has 'process_name' => (is => 'ro', isa => 'Str', default => sub { 'perl-fcgi' }); has 'manager_process_name' => (is => 'ro', isa => 'Str', default => sub { 'perl-fcgi-pm' }); ## methods ... sub BUILD { my $self = shift; unless ($self->no_signals()) { $self->sigaction_no_sa_restart( POSIX::SigAction->new( 'FCGI::Engine::ProcManager::sig_sub' ) ); $self->sigaction_sa_restart( POSIX::SigAction->new( 'FCGI::Engine::ProcManager::sig_sub', undef, POSIX::SA_RESTART ) ); } } # this is the signal handler ... { my $SIG_CODEREF; sub sig_sub { $SIG_CODEREF->(@_) if ref $SIG_CODEREF } sub clear_signal_handler { undef $SIG_CODEREF } sub setup_signal_handler { my $self = shift; $SIG_CODEREF = $self->role eq 'manager' ? sub { defined $self && $self->manager_sig_handler(@_) } : sub { defined $self && $self->server_sig_handler(@_) }; } } ## main loop ... sub manage { my $self = shift; # skip to handling now if we won't be managing any processes. $self->n_processes or return; # call the (possibly overloaded) management initialization hook. $self->role("manager"); $self->manager_init; $self->notify("initialized"); my $manager_pid = $$; MANAGING_LOOP: while (1) { # FIXME # we should tell the process that it is being # run under some kind of daemon, which will mean # that getppid will usually then return 1 # - SL #getppid() == 1 and # return $self->die("calling process has died"); $self->n_processes > 0 or return $self->die; # while we have fewer servers than we want. PIDS: while ($self->pid_count < $self->n_processes) { if (my $pid = fork) { # the manager remembers the server. $self->add_pid($pid); $self->notify("server (pid $pid) started"); } elsif (! defined $pid) { return $self->abort("fork: $!"); } else { $self->manager_pid($manager_pid); # the server exits the managing loop. last MANAGING_LOOP; } for (my $s = $self->start_delay; $s; $s = sleep $s) {}; } # this should block until the next server dies. $self->wait; }# while 1 SERVER: # forget any children we had been collecting. $self->forget_all_pids; # call the (possibly overloaded) handling init hook $self->role("server"); $self->server_init; $self->notify("initialized"); # server returns return 1; } ## initializers ... sub manager_init { my $self = shift; unless ($self->no_signals) { $self->setup_signal_actions(with_sa_restart => 0); $self->setup_signal_handler; } $self->change_process_name; eval { $self->pidfile->write }; $self->notify("Could not write the PID file because: $@") if $@; inner(); } sub server_init { my $self = shift; unless ($self->no_signals) { $self->setup_signal_actions(with_sa_restart => 0); $self->setup_signal_handler; } $self->change_process_name; inner(); } ## hooks ... sub pre_dispatch { my $self = shift; $self->setup_signal_actions(with_sa_restart => 1) unless $self->no_signals; inner(); } sub post_dispatch { my $self = shift; $self->exit("safe exit after SIGTERM") if $self->received_signal("TERM"); $self->exit("safe exit after SIGHUP") if $self->received_signal("HUP"); if ($self->manager_pid and getppid() != $self->manager_pid) { $self->exit("safe exit: manager has died"); } $self->setup_signal_actions(with_sa_restart => 0) unless $self->no_signals; inner(); } ## utils ... # sig-handlers sub manager_sig_handler { my ($self, $name) = @_; if ($name eq "TERM") { $self->notify("received signal $name"); $self->die("safe exit from signal $name"); } elsif ($name eq "HUP") { # send a TERM to each of the servers, # and pretend like nothing happened.. if (my @pids = $self->get_all_pids) { $self->notify("sending TERM to PIDs, @pids"); kill TERM => @pids; } } else { $self->notify("ignoring signal $name"); } } sub server_sig_handler { my ($self, $name) = @_; $self->received_signal($name, 1); } sub received_signal { my ($self, $sig, $received) = @_; return $self->signals_received unless $sig; $self->signals_received->{$sig}++ if $received; return $self->signals_received->{$sig}; } sub change_process_name { my $self = shift; $0 = ($self->role eq 'manager' ? $self->manager_process_name : $self->process_name); } sub wait : method { my $self = shift; # wait for the next server to die. return if (my $pid = CORE::wait()) < 0; # notify when one of our servers have died. $self->remove_pid($pid) and $self->notify("server (pid $pid) exited with status $?"); return $pid; } ## signal handling stuff ... sub setup_signal_actions { my $self = shift; my %args = @_; my $sig_action = (exists $args{with_sa_restart} && $args{with_sa_restart}) ? $self->sigaction_sa_restart : $self->sigaction_no_sa_restart; POSIX::sigaction(POSIX::SIGTERM, $sig_action) || $self->notify("sigaction: SIGTERM: $!"); POSIX::sigaction(POSIX::SIGHUP, $sig_action) || $self->notify("sigaction: SIGHUP: $!"); } ## notification ... sub notify { my ($self, $msg) = @_; $msg =~ s/\s*$/\n/; print STDERR "FastCGI: " . $self->role() . " (pid $$): " . $msg; } ## error/exit handlers ... sub die : method { my ($self, $msg, $n) = @_; # stop handling signals. $self->clear_signal_handler; $SIG{HUP} = 'DEFAULT'; $SIG{TERM} = 'DEFAULT'; $self->pidfile->remove || $self->notify("Could not remove PID file: $!"); # prepare to die no matter what. if (defined $self->die_timeout) { $SIG{ALRM} = sub { $self->abort("wait timeout") }; alarm $self->die_timeout; } # send a TERM to each of the servers. if (my @pids = $self->get_all_pids) { $self->notify("sending TERM to PIDs, @pids"); kill TERM => @pids; } # wait for the servers to die. while ($self->has_pids) { $self->wait; } # die already. $self->exit("dying: $msg", $n); } sub abort { my ($self, $msg, $n) = @_; $n ||= 1; $self->exit($msg, 1); } sub exit : method { my ($self, $msg, $n) = @_; $n ||= 0; # if we still have children at this point, # something went wrong. SIGKILL them now. kill KILL => $self->get_all_pids if $self->has_pids; $self->notify($msg); $@ = $msg; CORE::exit $n; } 1; __END__ =pod =head1 NAME FCGI::Engine::ProcManager - module for managing FastCGI applications. =head1 DESCRIPTION This module is a refactoring of L, it behaves exactly the same, but the API is a little different. The function-oriented API has been removed in favor of object-oriented API. The C prefix has been removed from the hook routines and instead they now use the C and C functionality from L. More docs will come eventually. =head2 Signal Handling FCGI::Engine::ProcManager attempts to do the right thing for proper shutdowns. When it receives a SIGHUP, it sends a SIGTERM to each of its children, and then resumes its normal operations. When it receives a SIGTERM, it sends a SIGTERM to each of its children, sets an alarm(3) "die timeout" handler, and waits for each of its children to die. If all children die before this timeout, process manager exits with return status 0. If all children do not die by the time the "die timeout" occurs, the process manager sends a SIGKILL to each of the remaining children, and exists with return status 1. FCGI::Engine::ProcManager uses POSIX::sigaction() to override the default SA_RESTART policy used for perl's %SIG behavior. Specifically, the process manager never uses SA_RESTART, while the child FastCGI servers turn off SA_RESTART around the accept loop, but re-enstate it otherwise. The desired (and implemented) effect is to give a request as big a chance as possible to succeed and to delay their exits until after their request, while allowing the FastCGI servers waiting for new requests to die right away. =head1 METHODS I will fill this in more eventually, but for now if you really wanna know, read the source. =head1 SEE ALSO =over 4 =item L This module is a fork of the FCGI::ProcManager code, with lots of code cleanup as well as general Moosificaition. =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/PSGI.pm000644 000765 000024 00000007064 12376454264 017622 0ustar00stevanstaff000000 000000 package FCGI::Engine::PSGI; use Moose; use Plack::Util; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'FCGI::Engine::Core'; has 'app' => ( is => 'ro', isa => 'CodeRef', required => 1, ); # NOTE: # Most of this is taken from # Plack::Handler::FCGI or at # least heavily based on it. # - SL augment 'prepare_environment' => sub { my ($self, $env) = @_; return +{ %$env, 'psgi.version' => [1,0], 'psgi.url_scheme' => ($env->{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http', 'psgi.input' => *STDIN, 'psgi.errors' => *STDERR, # FCGI.pm redirects STDERR in Accept() loop, so just print STDERR # print to the correct error handle based on keep_stderr 'psgi.multithread' => Plack::Util::FALSE, 'psgi.multiprocess' => Plack::Util::TRUE, 'psgi.run_once' => Plack::Util::FALSE, 'psgi.streaming' => Plack::Util::TRUE, 'psgi.nonblocking' => Plack::Util::FALSE, }; }; sub handle_request { my ( $self, $env ) = @_; my $res = Plack::Util::run_app( $self->app, $env ); if (ref $res eq 'ARRAY') { $self->_handle_response($res); } elsif (ref $res eq 'CODE') { $res->(sub { $self->_handle_response($_[0]); }); } else { die "Bad response $res"; } } sub _handle_response { my ($self, $res) = @_; *STDOUT->autoflush(1); my $hdrs; $hdrs = "Status: $res->[0]\015\012"; my $headers = $res->[1]; while (my ($k, $v) = splice @$headers, 0, 2) { $hdrs .= "$k: $v\015\012"; } $hdrs .= "\015\012"; print STDOUT $hdrs; my $cb = sub { print STDOUT $_[0] }; my $body = $res->[2]; if (defined $body) { Plack::Util::foreach($body, $cb); } else { return Plack::Util::inline_object write => $cb, close => sub { }; } } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME FCGI::Engine::PSGI - Run PSGI applications with FCGI::Engine =head1 SYNOPSIS # in scripts/my_psgi_app_fcgi.pl use strict; use warnings; use FCGI::Engine::PSGI; FCGI::Engine::PSGI->new_with_options( app => sub { my $env = shift; [ 200, [ 'Content-type' => 'text/html' ], [ "Hello World" ] ] } )->run; # run as normal FCGI script perl scripts/my_psgi_app_fcgi.pl # run as standalone FCGI server perl scripts/my_psgi_app_fcgi.pl --nproc 10 --pidfile /tmp/my_app.pid \ --listen /tmp/my_app.socket --daemon # see also FCGI::Engine::Manager for managing # multiple FastCGI backends under one script =head1 DESCRIPTION This is an extension of L to support L applications. You can refer to the L docs for most of what you need to know, the only difference being that instead of a C, C and C you simply have the C attribute, which is expected to be a L compliant application. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan.little@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2009-2010 Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/Types.pm000644 000765 000024 00000004363 12376454572 020165 0ustar00stevanstaff000000 000000 package FCGI::Engine::Types; use Moose::Util::TypeConstraints; use Declare::Constraints::Simple '-All'; use MooseX::Getopt::OptionTypeMap; use MooseX::Types::Path::Class; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; ## FCGI::Engine subtype 'FCGI::Engine::ListenerPort' => as 'Str' => where { /\:(\d+)/ && $1 >= 1 && $1 <= 65535 }; subtype 'FCGI::Engine::Listener' => as 'FCGI::Engine::ListenerPort | Path::Class::File'; MooseX::Getopt::OptionTypeMap->add_option_type_to_map( 'FCGI::Engine::Listener' => '=s', ); ## FCGI::Engine::Manager # FIXME: # this is ugly I know, but it is better # then adding a backward incompatible # change and forcing others to update # their versions of Moose for this. # - SL if ($Moose::VERSION < 0.72) { subtype 'FCGI::Engine::Manager::Server::Config' => as 'HashRef' => And( IsHashRef, HasAllKeys(qw[scriptname pidfile socket]), OnHashKeys( additional_args => IsArrayRef ) ); } else { subtype('FCGI::Engine::Manager::Server::Config', { as => 'HashRef', where => And( IsHashRef, HasAllKeys(qw[scriptname pidfile socket]), OnHashKeys( additional_args => IsArrayRef ) ) } ); } subtype 'FCGI::Engine::Manager::Config' => as 'ArrayRef[FCGI::Engine::Manager::Server::Config]'; ## FCGI::Engine::ProcManager enum 'FCGI::Engine::ProcManager::Role' => [ qw[manager server] ]; 1; __END__ =pod =head1 NAME FCGI::Engine::Types - Type constraints for FCGI::Engine =head1 DESCRIPTION This is all the type constraints needed by the FCGI::Engine modules, no user serviceable parts inside (unless you are subclassing stuff). =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cutFCGI-Engine-0.22/lib/FCGI/Engine/ProcManager/Constrained.pm000644 000765 000024 00000017143 12376455212 023520 0ustar00stevanstaff000000 000000 package FCGI::Engine::ProcManager::Constrained; use Moose; use Config; use Class::Load (); use Try::Tiny; extends 'FCGI::Engine::ProcManager'; sub BUILD { my $self = shift; if ($self->sizecheck_num_requests && ! _can_check_size()) { confess "Cannot load size check modules for your platform: sizecheck_num_requests > 0 unsupported"; } } has max_requests => ( isa => 'Int', is => 'ro', # FIXME - This is fuck ugly. default => sub { $ENV{PM_MAX_REQUESTS} || 0 }, ); has request_count => ( isa => 'Int', is => 'ro', traits => ['Counter'], handles => { _reset_request_counter => 'reset', _inc_request_counter => 'inc', }, init_arg => undef, default => 0, ); has [qw/ sizecheck_num_requests max_process_size min_share_size max_unshared_size /] => ( isa => 'Int', is => 'ro', default => 0, ); augment server_init => sub { my $self = shift; $self->_reset_request_counter(); }; augment post_dispatch => sub { my $self = shift; $self->exit("safe exit after max_requests (" . $self->max_requests . ")") if ($self->max_requests and $self->_inc_request_counter == $self->max_requests); if ($self->sizecheck_num_requests and $self->request_count # Not the first request and $self->request_count % $self->sizecheck_num_requests == 0 ) { $self->exit("safe exit due to memory limits exceeded after " . $self->request_count . " requests") if $self->_limits_are_exceeded; } }; sub _limits_are_exceeded { my $self = shift; my ($size, $share, $unshared) = $self->_check_size(); return 1 if $self->max_process_size && $size > $self->max_process_size; return 0 unless $share; return 1 if $self->min_share_size && $share < $self->min_share_size; return 1 if $self->max_unshared_size && $unshared > $self->max_unshared_size; return 0; } # The following code is wholesale is nicked from Apache::SizeLimit::Core sub _check_size { my $class = shift; my ($size, $share) = $class->_platform_check_size(); return ($size, $share, $size - $share); } sub _load { my $mod = shift; try { Class::Load::load_class($mod); 1; } } our $USE_SMAPS; BEGIN { my ($major,$minor) = split(/\./, $Config{'osvers'}); if ($Config{'osname'} eq 'solaris' && (($major > 2) || ($major == 2 && $minor >= 6))) { *_can_check_size = sub () { 1 }; *_platform_check_size = \&_solaris_2_6_size_check; *_platform_getppid = \&_perl_getppid; } elsif ($Config{'osname'} eq 'linux' && _load('Linux::Pid')) { *_platform_getppid = \&_linux_getppid; *_can_check_size = sub () { 1 }; if (_load('Linux::Smaps') && Linux::Smaps->new($$)) { $USE_SMAPS = 1; *_platform_check_size = \&_linux_smaps_size_check; } else { $USE_SMAPS = 0; *_platform_check_size = \&_linux_size_check; } } elsif ($Config{'osname'} =~ /(?:bsd|aix)/i && _load('BSD::Resource')) { # on OSX, getrusage() is returning 0 for proc & shared size. *_can_check_size = sub () { 1 }; *_platform_check_size = \&_bsd_size_check; *_platform_getppid = \&_perl_getppid; } else { *_can_check_size = sub () { 0 }; } } sub _linux_smaps_size_check { my $class = shift; return $class->_linux_size_check() unless $USE_SMAPS; my $s = Linux::Smaps->new($$)->all; return ($s->size, $s->shared_clean + $s->shared_dirty); } sub _linux_size_check { my $class = shift; my ($size, $share) = (0, 0); if (open my $fh, '<', '/proc/self/statm') { ($size, $share) = (split /\s/, scalar <$fh>)[0,2]; close $fh; } else { $class->_error_log("Fatal Error: couldn't access /proc/self/status"); } # linux on intel x86 has 4KB page size... return ($size * 4, $share * 4); } sub _solaris_2_6_size_check { my $class = shift; my $size = -s "/proc/self/as" or $class->_error_log("Fatal Error: /proc/self/as doesn't exist or is empty"); $size = int($size / 1024); # return 0 for share, to avoid undef warnings return ($size, 0); } # rss is in KB but ixrss is in BYTES. # This is true on at least FreeBSD, OpenBSD, & NetBSD sub _bsd_size_check { my @results = BSD::Resource::getrusage(); my $max_rss = $results[2]; my $max_ixrss = int ( $results[3] / 1024 ); return ($max_rss, $max_ixrss); } sub _win32_size_check { my $class = shift; # get handle on current process my $get_current_process = Win32::API->new( 'kernel32', 'get_current_process', [], 'I' ); my $proc = $get_current_process->Call(); # memory usage is bundled up in ProcessMemoryCounters structure # populated by GetProcessMemoryInfo() win32 call my $DWORD = 'B32'; # 32 bits my $SIZE_T = 'I'; # unsigned integer # build a buffer structure to populate my $pmem_struct = "$DWORD" x 2 . "$SIZE_T" x 8; my $mem_counters = pack( $pmem_struct, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ); # GetProcessMemoryInfo is in "psapi.dll" my $get_process_memory_info = new Win32::API( 'psapi', 'GetProcessMemoryInfo', [ 'I', 'P', 'I' ], 'I' ); my $bool = $get_process_memory_info->Call( $proc, $mem_counters, length $mem_counters, ); # unpack ProcessMemoryCounters structure my $peak_working_set_size = (unpack($pmem_struct, $mem_counters))[2]; # only care about peak working set size my $size = int($peak_working_set_size / 1024); return ($size, 0); } sub _perl_getppid { return getppid } sub _linux_getppid { return Linux::Pid::getppid() } no Moose; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =head1 NAME FCGI::Engine::ProcManager::Constrained - FastCGI applications with memory and number of request limits. =head1 DESCRIPTION A constrained process manager that restarts child workers after a number of requests or if they use too much memory. Most of the memory usage code is stolen from L. =head1 ATTRIBUTES =head2 max_requests The number of requests a child process can handle before being terminated. 0 (the default) means let child processes do an infinite number of requests =head2 sizecheck_num_requests The number of requests between a check on the process size taking place. 0 (the default) means never attempt to check the process size. =head2 max_process_size The maximum size of the process (both shared and unshared memory) in KB. 0 (the default) means unlimited. =head2 max_unshared_size The maximum amount of memory in KB this process can have that isn't Copy-On-Write shared with other processes. 0 (the default) means unlimited. =head2 min_share_size The minimum amount of memory in KB this process can have Copy-On-Write from it's parent process before it is terminate. =head1 METHODS I will fill this in more eventually, but for now if you really wanna know, read the source. =head1 SEE ALSO =over =item L =item L. =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Tomas Doran Ebobtfish@bobtfish.netE =head1 COPYRIGHT AND LICENSE Code sections copied from L are Copyright their respective authors. Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/Manager/Server/000755 000765 000024 00000000000 12376456042 021327 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/lib/FCGI/Engine/Manager/Server.pm000644 000765 000024 00000004715 12376454263 021677 0ustar00stevanstaff000000 000000 package FCGI::Engine::Manager::Server; use Moose; use MooseX::Daemonize::Pid::File; use FCGI::Engine::Types; use Config; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; has 'name' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { ((shift)->scriptname . '.server') } ); has 'socket' => ( is => 'ro', isa => 'FCGI::Engine::Listener', coerce => 1, required => 1, ); has $_ => ( is => 'ro', isa => 'Path::Class::File', coerce => 1, required => 1, ) for qw[ scriptname pidfile ]; has 'nproc' => ( is => 'ro', isa => 'Int', default => sub { 1 } ); has 'additional_args' => ( is => 'ro', isa => 'ArrayRef', auto_deref => 1, predicate => 'has_additional_args' ); ## ... internal attributes has 'pid_obj' => ( is => 'ro', isa => 'MooseX::Daemonize::Pid::File', lazy => 1, default => sub { MooseX::Daemonize::Pid::File->new(file => (shift)->pidfile) }, clearer => 'remove_pid_obj', ); ## methods ... sub construct_command_line { my $self = shift; my $perl = $Config{perlpath}; $perl .= $Config{_exe} if $^O ne 'VMS' and $perl !~ /$Config{_exe}$/i; return ($perl, ($self->has_additional_args ? $self->additional_args : ()), $self->scriptname, "--nproc", $self->nproc, "--pidfile", $self->pidfile, "--listen", $self->socket, "--daemon"); } # NOTE: # perhaps the server status information # should also go in here, so that we can # keep it all in one place. # - SL 1; __END__ =pod =head1 NAME FCGI::Engine::Manager::Server - An abstraction to represent a single FCGI::Engine server =head1 DESCRIPTION Nothing here to see really, this just models the individual server information in the config file for FCGI::Engine::Manager. It also handles creating the command line as well. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/Manager/Server/FreeBSD6.pm000644 000765 000024 00000002654 12376454262 023176 0ustar00stevanstaff000000 000000 package FCGI::Engine::Manager::Server::FreeBSD6; use Moose; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'FCGI::Engine::Manager::Server'; override 'construct_command_line' => sub { my @command_line = super(); pop @command_line; return ( "/usr/sbin/daemon", "sh", "-c", (join " " => @command_line) ); }; 1; __END__ =pod =head1 NAME FCGI::Engine::Manager::Server::FreeBSD6 - A subclass of FCGI::Engine::Manager::Server specific to FreeBSD 6.* =head1 DESCRIPTION This may not even be needed anymore, but at one time it was. This works around the fact that L didn't like to be dameonized on FreeBSD 6.*. I suspect that now that I have switched this to use L that it is no longer an issue. But at this point I have not have the opportunity to test this theory, so I am leaving this here for historical purposes and as an example of subclassing L. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/lib/FCGI/Engine/Manager/Server/Plackup.pm000644 000765 000024 00000003115 12376454261 023265 0ustar00stevanstaff000000 000000 package FCGI::Engine::Manager::Server::Plackup; use Moose; our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; extends 'FCGI::Engine::Manager::Server'; has 'server_type' => ( is => 'ro', isa => 'Str', default => sub { 'FCGI::Engine' } ); has 'workers' => ( is => 'ro', isa => 'Int' ); sub construct_command_line { my $self = shift; return ("plackup", $self->scriptname, "--server", $self->server_type, ( $self->workers ? ( "--workers", $self->workers ) : ( "--nproc", $self->nproc ) ), "--pid", $self->pidfile, "--listen", $self->socket, "--daemonize", ($self->has_additional_args ? $self->additional_args : ())); } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME FCGI::Engine::Manager::Server::Plackup - A subclass of FCGI::Engine::Manager::Server for Plack apps =head1 DESCRIPTION This uses the C utility that comes with L to manage a L FCGI application. See L for details on how to configure things. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2010 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut FCGI-Engine-0.22/inc/Module/000755 000765 000024 00000000000 12376456042 016022 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/inc/Module/Install/000755 000765 000024 00000000000 12376456042 017430 5ustar00stevanstaff000000 000000 FCGI-Engine-0.22/inc/Module/Install.pm000644 000765 000024 00000030111 12376455115 017762 0ustar00stevanstaff000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.10'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; __END__ #line 485 FCGI-Engine-0.22/inc/Module/Install/Base.pm000644 000765 000024 00000002147 12376455115 020644 0ustar00stevanstaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.10'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 FCGI-Engine-0.22/inc/Module/Install/Can.pm000644 000765 000024 00000006157 12376455115 020500 0ustar00stevanstaff000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 FCGI-Engine-0.22/inc/Module/Install/Fetch.pm000644 000765 000024 00000004653 12376455115 021027 0ustar00stevanstaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; __END__ #line 109 FCGI-Engine-0.22/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 12376455115 021520 0ustar00stevanstaff000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 FCGI-Engine-0.22/inc/Module/Install/Metadata.pm000644 000765 000024 00000047322 12376455115 021516 0ustar00stevanstaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ## from Software-License - should we be using S-L instead ? # duplicates commeted out, see hack above ^^ # open_source => 'http://www.gnu.org/licenses/agpl-3.0.txt', # apache => 'http://www.apache.org/licenses/LICENSE-1.1', apache => 'http://www.apache.org/licenses/LICENSE-2.0.txt', artistic => 'http://www.perlfoundation.org/artistic_license_1_0', artistic_2 => 'http://www.perlfoundation.org/artistic_license_2_0', bsd => 'http://opensource.org/licenses/BSD-3-Clause', # unrestricted => 'http://creativecommons.org/publicdomain/zero/1.0/', # open_source => 'http://www.freebsd.org/copyright/freebsd-license.html', # open_source => 'http://www.gnu.org/licenses/fdl-1.2.txt', # open_source => 'http://www.gnu.org/licenses/fdl-1.3.txt', # gpl => 'http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt', # gpl => 'http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt', gpl => 'http://www.gnu.org/licenses/gpl-3.0.txt', # lgpl => 'http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt', lgpl => 'http://www.gnu.org/licenses/lgpl-3.0.txt', mit => 'http://www.opensource.org/licenses/mit-license.php', # mozilla => 'http://www.mozilla.org/MPL/MPL-1.0.txt', # mozilla => 'http://www.mozilla.org/MPL/MPL-1.1.txt', mozilla => 'http://www.mozilla.org/MPL/2.0/index.txt', # restrictive => '', # open_source => 'http://www.openssl.org/source/license.html', perl => 'http://dev.perl.org/licenses/', # open_source => 'http://www.opensource.org/licenses/postgresql', # open_source => 'http://trolltech.com/products/qt/licenses/licensing/qpl', # unrestricted => 'http://h71000.www7.hp.com/doc/83final/BA554_90007/apcs02.html', # open_source => 'http://www.openoffice.org/licenses/sissl_license.html', # open_source => 'http://www.zlib.net/zlib_license.html', ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, # the following are relied on by the test system even if they are wrong :( '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'LGPL' => 'lgpl', 1, 'MIT' => 'mit', 1, ## from Software-License 'The GNU Affero General Public License, Version 3, November 2007' => 'open_source', 1, 'The Apache Software License, Version 1.1' => 'apache', 1, 'The Apache License, Version 2.0, January 2004' => 'apache', 1, 'The Artistic License 1.0' => 'artistic', 1, 'The Artistic License 2.0 (GPL Compatible)' => 'artistic_2', 1, 'The (three-clause) BSD License' => 'bsd', 1, 'CC0 License' => 'unrestricted', 1, 'The (two-clause) FreeBSD License' => 'open_source', 1, 'GNU Free Documentation License v1.2' => 'open_source', 1, 'GNU Free Documentation License v1.3' => 'open_source', 1, 'The GNU General Public License, Version 1, February 1989' => 'gpl', 1, 'The GNU General Public License, Version 2, June 1991' => 'gpl', 1, 'The GNU General Public License, Version 3, June 2007' => 'gpl', 1, 'The GNU Lesser General Public License, Version 2.1, February 1999' => 'lgpl', 1, 'The GNU Lesser General Public License, Version 3, June 2007' => 'lgpl', 1, 'The MIT (X11) License' => 'mit', 1, 'The Mozilla Public License 1.0' => 'mozilla', 1, 'The Mozilla Public License 1.1' => 'mozilla', 1, 'Mozilla Public License Version 2.0' => 'mozilla', 1, '"No License" License' => 'restrictive', 1, 'OpenSSL License' => 'open_source', 1, 'the same terms as the perl 5 programming language system itself' => 'perl', 1, 'The PostgreSQL License' => 'open_source', 1, 'The Q Public License, Version 1.0' => 'open_source', 1, 'Original SSLeay License' => 'unrestricted', 1, 'Sun Internet Standards Source License (SISSL)' => 'open_source', 1, 'The zlib License' => 'open_source', 1, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; __END__ #line 766 FCGI-Engine-0.22/inc/Module/Install/Win32.pm000644 000765 000024 00000003426 12376455115 020675 0ustar00stevanstaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; __END__ #line 80 FCGI-Engine-0.22/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002421 12376455115 021510 0ustar00stevanstaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; __END__ #line 79