Plack-1.0039/000755 000765 000024 00000000000 12631015706 013603 5ustar00miyagawastaff000000 000000 Plack-1.0039/benchmarks/000755 000765 000024 00000000000 12631015706 015720 5ustar00miyagawastaff000000 000000 Plack-1.0039/Changes000644 000765 000024 00000142723 12631015706 015107 0ustar00miyagawastaff000000 000000 Go to http://github.com/plack/Plack/issues for the roadmap and known issues. 1.0039 2015-12-06 03:27:59 PST [BUG FIXES] - Revert the change to use the faster header builder because it breaks the legit Plack::Response constructor that sets HTTP::Header object directly (#541) 1.0038 2015-11-25 12:36:29 PST [IMPROVEMENTS] - Added MIME type for apk files #514 (allanwhiteford) - Allow passing custom formatters to Plack::Middleware::AccessLog #515 (frew) - Allow '0' be a valid category for log4perl middleware #523 - Doc fix for Plack::Runner #528 (polettix) - Doc improvements for -R/-M command line #529 (mickeyn) - Bind test server explicitly on 127.0.0.1, not 0.0.0.0 - Support single-process manager in FCGI #535 (ianburrell) - Optimize Plack::Response header builder #540 (kazeburo) 1.0037 2015-06-19 10:01:31 PDT [Improvements] - Lint: Support HTTP/2 in SERVER_PROTOCOL (kazuho) #511 - Bump HTTP::Headers::Fast dependency #512 1.0036 2015-06-03 12:01:53 PDT [BUG FIXES] - Fix CGIBin test to not use CGI.pm #509 1.0035 2015-04-16 10:08:21 CEST [BUG FIXES] - Fixed parsing of empty query string pairs (aristotle) #500 [IMPROVEMENTS] - Documentation updates for FCGI (otrosien) #494 - Use HTTP::Headers::Fast in Plack::Request - Big performance optimizations on Plack::Util::header_* (aristotle) #498 - Added .webm to Plack::MIME (marlencrabapple) #503 - Use Cookie::Baker to bake cookies in Plack::Response (oalders) - reduced the size of distribution by making binary files smaller 1.0034 2015-02-02 21:42:42 CET [SECURITY] - Fixed a possible directory traversal with Plack::App::File on Win32 (sri) [IMPROVEMENTS] - Documentation improvements (timbunce, oalders, autarch, frioux) - Avoid warnings in Plack::App::WrapCGI (frioux) 1.0033 2014-10-23 12:33:18 PDT [BUG FIXES] - Lint: Fix error messages (fgabolde) #473 - ErrorDocument: Reverse the $done filtering (nwellnhof) #474 [IMPROVEMENTS] - StackTrace: Improve the accuracy of thrown exceptions in case where an excpetion is thrown in destructors (nwellnhof) #476 1.0032 2014-10-04 11:13:24 PDT [IMPROVEMENTS] - Support Server::Starter in FCGI handler (yuryu) #435 - Various documentation fixes 1.0031 2014-08-01 13:19:14 PDT [SECURITY] - Plack::App::File would previously strip trailing slashes off provided paths. This in combination with the common pattern of serving files with Plack::Middleware::Static could allow an attacker to bypass a whitelist of generated files (avar) #446 [IMPROVEMENTS] - Let HTTP::Message::PSGI warn in case of invalid PSGI response (wchristian) #437 - Update documentation on how response_cb works with writer (doy) - Make AccessLog work on non-POSIX environment (dex4er) #442 - Plack::App::WrapCGI no longer warns under 5.19.9 (frew) - Avoid Rosetta Flash attack in JSONP middleware (nichtich) #464 - Fix Plack::Util::inline_object to make it work with can() as a class method [NEW FEATURES] - Add $req->query_string shortcut to access QUERY_STRING in PSGI environment 1.0030 2013-11-23 08:54:01 CET [IMPROVEMENTS] - Middleware::LogDispatch stringifies objects (oalders) #427 - Encode wide character strings as UTF-8 in HTTP::Server::PSGI #429 - Optimize Plack::Response->finalize performance (kazeburo) #433 - Optimize mount() performance in Plack::App::URLMap [BUG FIXES] - ErrorDocument: remove Content-Encoding and Transfer-Encoding (kazeburo) #430 - Fix harakiri test hang on win32 (wchristian) #431 - Handler::FCGI: Restore --keep-stderr option (mauzo) #432 1.0029 2013-08-22 14:05:44 PDT [NEW FEATURES] - Plack::Test now has a simpler object-oriented interface that doesn't take multiple callbacks. #420 [IMPROVEMENTS] - bump dependencies for Test::TCP and HTTP::Tiny - Set no_proxy for HTTP::Tiny in tests (kazeburo) [INCOMPATIBLE CHANGES] - Split HTTP::Server::Simple handler from Plack distribution and merge to HTTP-Server-Simple-PSGI distribution 1.0028 2013-06-15 01:42:52 PDT [IMPROVEMENTS] - Skip cgi related tests for Win32 (chorny) #413 - Skip tests that could potentially write empty bytes, which could cause issues on some servers on local sockets with HTTP::Tiny - Skip tests that require HTTP::Cookies, if not available #414 1.0027 2013-06-13 21:30:12 PDT [IMPROVEMENTS] - Not a dev release, including XS free version of Plack::Test* - Fix cgibin tests that often fail on Win32 #375 1.0026 2013-06-12 23:00:21 PDT [INCOMPATIBLE CHANGES] - use HTTP::Tiny in Plack::Test::Suite and Plack::Test::Server rather than skipping it. 1.0025 2013-06-12 13:08:58 PDT [INCOMPATIBLE CHANGES] - No XS! Eliminates dependency to LWP::UserAgent by making it completely optional for testing. If you run Plack::Test with Server implementation or run Plack::Test::Suite (for PSGI handlers) without LWP installed, the tests will automatically be skipped. This removes the eventual sub-dependency to HTML::Parser, which is the only XS dependency in Plack. #408 [IMPROVEMENTS] - Fixed the warning in OO usage of Plack::Builder (doy) #407 - Shotgun loader now dies if used in Win32 since it leaks memory #320, #400 - Suppress warnings for Test::TCP (kazeburo) #406 - $res->to_app shortcut (ether) #409 1.0024 2013-05-01 10:05:56 PDT [IMPROVEMENTS] - Fix warnings for Plack::App::WrapCGI (frioux) - Ignore emacs lock file from restarter (maio) - Add documentation for environment variable in Auth::Basic - Some Metadata cleanup and Travis CI 1.0023 2013-04-08 11:13:11 PDT [IMPROVEMENTS] - Use Apache::LogFormat::Compiler in AccessLog (kazeburo) 1.0022 2013-04-02 12:37:42 PDT [BUG FIXES] - Fixed a major bug in 1.0020-1.0021 where posix_default prevents arbitrary arguments for plackup-compat (e.g. starman) to handle them (Thanks to justnoxx) Starman#66 [IMPROVEMENTS] - Fixed test warnings (Keedi Kim) 1.0021 2013-04-02 11:20:00 PDT - Repackage with Milla v0.9.6 #392 1.0020 2013-04-01 19:34:54 PDT [INCOMPATIBLE CHANGES] - Enable posix_default and gnu_compat in plackup Getopt, so that ambiguous option names do not match with long options accidentally [IMPROVEMENTS] - Document fix for the AccessLog (ether) - Special-case Content-Length and Content-Type for %{}i in AccessLog format #387 1.0019 2013-04-01 17:58:25 PDT - Trial release with Milla 1.0018 Fri Mar 8 10:43:45 PST 2013 [IMPROVEMENTS] - Performance boost in Plack::Request#query_parameters (lestrrat) - Added custom log formats for %m, %U, %q and %H (Hiroshi Sakai) - Fixed warnings in SimpleContentFilter (earino) [DOCUMENTATION] - Added docs about plackup --path - Added docs about using manager object in Plack::Handler::FCGI 1.0017-TRIAL Thu Feb 7 19:21:24 PST 2013 [INCOMPATIBLE CHANGES] - Gives you warnings when you use one of Plack::App objects in `plackup -e` or in .psgi files but forgot to call ->to_app to make it a PSGI application (#369) Still automatically converts them for backward compatibility, but in the loading time inside Plack::Builder. [BUG FIXES] - chdir to the CGI path when executing CGIBin (#338, #368) 1.0016 Thu Jan 31 13:21:14 PST 2013 [SECURITY] - Fixed directory traversal bug in Plack::App::File on win32 environments [INCOMPATIBLE CHANGES] - Updated Plack::Builder OO interface to be more natural. Still keeps backward compatible to the old ->mount() and ->to_app() interface. [NEW FEATURES] - Static middleware 'path' callback now takes $env as a 2nd argument (avar) - Static middleware takes 'content_type' callback to determine custom MIME (pstadt) [IMPROVEMENTS] - Fixed regexp warning for blead (doy) - Documentation update for AccessLog::Timed to suggest Runtime (ether) - Ignore vim swap files on restarter (nihen) - Major doucmentation overhaul on Apache2 startup files (rkitover, avar) 1.0015 Thu Jan 10 15:19:17 PST 2013 [BUG FIXES] - Fixed Lint complaining about Latin-1 range characters stored internally with utf8 flag on (Mark Fowler) - HTTP::Message::PSGI::res_from_psgi now always returns empty string for an empty response body, so streamed responses are consistent with non-streamed (ether) 1.0014 Mon Dec 3 10:27:43 PST 2012 [BUG FIXES] - Fixed Hash order in tests for perl 5.17 (doy) - Fixed StackTrace tests to run with Devel::StackTrace [IMPROVEMENTS] - Plack::Middleware::AccessLog can now log the worker pid and server port (ether) 1.0013 Wed Nov 14 19:46:49 PST 2012 [BUG FIXES] - Make sure psgi.input is seeked even when the input is buffered (Getty, leedo) - Delete invalid (empty) CONTENT_LENGTH and CONTENT_TYPE in FCGI (Getty, leedo) 1.0012 Wed Nov 14 12:00:17 PST 2012 [IMPROVEMENTS] - Make conditional middleware work with initialization without an app (doy) - Added force option to BufferedStreaming 1.0011 Sun Nov 11 11:05:30 PST 2012 [BUG FIXES] - Fix bad Content-Length that could be caused with mod_perl (avar) - Allow an empty PATH_INFO in Lint per PSGI spec 1.0010 Fri Nov 2 13:30:50 PDT 2012 [IMPROVEMENTS] - Added vim .swp files to the default ignore list in Restarter - Check if PATH_INFO begins with / in Lint 1.0009 Tue Oct 23 00:57:16 PDT 2012 [BUG FIXES] - Correct fix to address drive letters for Win32 1.0008 Mon Oct 22 18:52:29 PDT 2012 [BUG FIXES] - Allow drive letters for absolute paths for plackup and load_psgi #343 1.0007 Sat Oct 20 23:20:20 PDT 2012 [IMPROVEMENTS] - Fix test failures with HTTP::Message 6.06. #345 - relaxed plackup -R ignore files and directoris. #260 1.0006 Thu Oct 18 16:06:15 PDT 2012 [INCOMPATIBLE CHANGES] - plackup foo.psgi will not search the file in @INC anymore before the current directory See https://github.com/plack/Plack/pull/343 for details (miyagawa) [NEW FEATURES] - plackup --path /foo will mount the application under /path (mattn) [BUG FIXES] - AccessLog: Fix the timezon offset for certain timezones - ErrorDocument: support streaming interface 1.0005 Tue Oct 9 13:33:47 PDT 2012 [NEW FEATURES] - Support psgix.cleanup handlers in Apache2 (avar) - Added REMOTE_PORT environment variable to HTTP::Server::PSGI (dex4er) [IMPROVEMENTS] - Documentation fix for multiple cookie values (miyagawa) - Delete MOD_PERL environment variable for better compatibilities (avar) - Split out Plack::TempBuffer as a standalone Stream::Buffered module (doy) - Bump Test::TCP dep 1.0004 Thu Sep 20 08:36:11 JST 2012 [NEW FEATURES] - Added psgix.harakiri support in HTTP::Server::PSGI [IMPROVEMENTS] - Preload TempBuffer modules (avar) - Documentation fixes (autarch) 1.0003 Wed Aug 29 13:44:53 PDT 2012 [BUG FIXES] - Fix Basic authentication error in case password contains a colon #319 - Fix AccessLog middleware in platforms where %z strftime is not supported #318 - Escape $_ in Plack::Request path method due to a possible URI::Escape bug 1.0002 Mon Aug 13 17:04:25 PDT 2012 [NEW FEATURES] - Added --no-default-middleware option to plackup #290 [BUG FIXES] - Use C locale for AccessLog strftime #313 - Escape Plack::Request URI path using RFC 3986 definition (ssmccoy) [IMPROVEMENTS] - Documentation improvements (ether, Tom Heady) - Skip displaying ".." in Plack::App::Directory #277 - Document load_class() doesn't validate user input. #285 1.0001 Thu Jul 26 16:24:13 PDT 2012 [INCOMPATIBLE CHANGES] - Deleted lots of code, methods and warnings that have been deprecated since 0.99 (which should have been done in the 1.0000 release) [DEVELOPERS] - Added bootstrap script to install devel dependencies [IMPROVEMENTS] - Fixed version numbers in some of the modules that have their own $VERSION 1.0000 Thu Jul 19 18:59:18 PDT 2012 - This be 1.0! (Same as 0.9991) 0.9991 Thu Jul 19 17:27:52 PDT 2012 [NEW FEATURES] - Added IIS7 fix middleware (t0m) 0.9990 Wed Jul 18 11:12:07 PDT 2012 [INCOMPATIBILE CHANGES] - Plack::Request changes the way it parses QUERY_STRING for valueless keys such as "?a&b=1". Now "a" becomes part of query_parameters with empty string as its value (yannk) [IMPROVEMENTS] - Support max-age options in Plack::Response cookies (remorse) - Pass correct protocol from HTTP::Server::PSGI to display https URL correctly (siracusa) - Copy Authorization header from FastCGI handler (ray1729) - Stop special casing COOKIE environment variable in Plack::Request headers (doy) 0.9989 Thu Jun 21 13:39:11 PDT 2012 [IMPROVEMENTS] - Support streaming in Head middleware (wreis) - Document middleware prefixing (Jon Swartz) - Make Basic authentication detection case insensitive per RFC (Mark Fowler) - Added backlog option to FCGI handler (xaicron) 0.9988 Fri May 11 12:25:09 CEST 2012 [BUG FIXES] - Fixes HTTP_HOST in HTTP::Message::PSGI #287 (doy) 0.9987 Thu May 10 07:06:32 CEST 2012 [IMPROVEMENTS] - Support streaming in AccessLog::Timed (Peter Makholm) - Support streaming in ErrorDocument - Removed UTF8 hack in HTTP::Message::PSGI. Depends on URI.pm 1.59 (wreis) - Set Host headers correctly in HTTP::Message::PSGI #177 - Added documentation on supported %-flags in AccessLog (ether) - Skip unnecessary tests on non-developer environment 0.9986 Mon Mar 12 11:26:59 PDT 2012 [IMPROVEMENTS] - Use I/O handles to FCGI::Request instead of global STDIN, STDOUT etc. (chansen) - Improved FastCGI docs (osfameron) - Cascade app now returns the last response code (aristotle) 0.9985 Mon Oct 31 13:11:19 PDT 2011 [BUG FIXES] - Short circuit Plack::Handler fallback to avoid %INC bugs in perl 5.8 (mst) - Fixed Makefile.PL to avoid Test::SharedFork interferring with Module::Install (ambs) 0.9984 Mon Oct 3 09:55:05 PDT 2011 [BUG FIXES] - WrapCGI: Close wrapped CGI's STDIN handle (rwstauner) [IMPROVEMENTS] - WrapCGI: improved docs (chromatic) - Request: Do not destroy HTTP::Body upload headers (mst) 0.9983 Tue Sep 27 09:55:48 PDT 2011 [BUG FIXES] - Fixed a typo in nginx FastCGI configuration - Clone HTTP headers in Response->finalize #237 (chip) - Fixed Directory app not displaying the right path in its title - Changed IPv6 default listen address to wildcard (ollyg) - Fixed the FastCGI handler with web-server mode on Win32 [NEW FEATURES] - Added psgix.harakiri for Apache handlers [IMPROVEMENTS] - Prefer Corona when Coro is detected #236 (chip) - Increased Pod::Usage dependency - Improved Plack::Test documentation (chromatic) - Lint now checks if SCRIPT_NAME eq '/' which is forbidden in the spec (chromatic) 0.9982 Tue Jul 19 13:07:35 PDT 2011 [BUG FIXES] - Fixed the bug in restarter introduced in 0.9980 (nihen) #223 #234 - Removed a debug statement left over in Plack::Util - Fixed warnings in Lint 0.9981 Mon Jul 18 17:24:11 PDT 2011 [BUG FIXES] - Plack::Request: Added a sanity check to remove newlines from headers to follow the PSGI specification #224 - HTTPParser::PP: Fixed warnings #225 - plackup now prints errors to psgi.errors rather than STDERR - Fixes issues with undef returned from streaming handler in middleware #231 - ContentLength: Do not auto-add Content-Length from block devices, pipes and character files [NEW FEATURES] - HTTPExceptions: Support ->as_psgi method on exceptions (doy) - FastCGI: Support psgix.harakiri [IMPROVEMENTS] - Lint: Added more checks to validate header values - StackTrace: Strip caller information since it is not useful anyway - HTTPExceptions: Added rethrow option (doy) - Misc. doc fixes on plackup (chromatic) - binmode STDIN for CGI handler for Win32 #218 - Remove the test that tests Server specific handling of Transfer-Encoding - Fixed POD link (audreyt) 0.9980 Mon Jun 6 20:24:25 PDT 2011 [BUG FIXES] - Fixed a bug where restarting loader doesn't terminate children (#209) - Strip URI fragments off of PATH_INFO and QUERY_STRING (#213) [IMPROVEMENTS] - Documented -r vs auto server detection caveat - Documented a default AccessLog format (ask) - Support %V in AccessLog formats (ask) - Document PLACK_HTTP_PARSER_PP (melo) [NEW FEATURES] - Added experimental IPv6 and SSL support for the built-in HTTP::Server::PSGI 0.9979 Tue May 17 09:54:03 PDT 2011 [BUG FIXES] - Fixed Middleware::AccessLog's default %t format to match Apache's format - Fixed a warning in Apache1 handler where PATH_INFO doesn't exist #204 - Fixed a bad test relying on new Test::More versions [IMPROVEMENTS] - Fixed Lint to accept bare in-memory filehandle per http://stackoverflow.com/questions/6011793/ - Added setup_env() to Plack::Handler::CGI (markstos) - Added a non-blocking Hello World example in eg/dot-psgi - Doc cleanup 0.9978 Wed May 4 11:29:12 PDT 2011 [TEST FIXES] - Fixed a failing output_encoding.t because of FCGI dependencies - Improved Plack::Test::Suite documentation 0.9977 Sun May 1 12:16:08 PDT 2011 [BUG FIXES] - Fixed ConditionalGET to not die with streaming interface (reported by Paul Ervamaa) - Add a reason string to CGI/FastCGI Status header to comply with RFC 3875 (Stephen Clouse) - Fixed a CGI/FastCGI handler to ensure newlines are not mangled on Win32 platforms (Christian Walde) [IMPROVEMENTS] - localize @ARGV to empty when evaluating a PSGI application (https://github.com/sukria/Dancer/issues/473) - Fixed the use of Getopt::Long to make the pass_through flag local - Middleware::JSONP now supports more response types such as IO::Handle (reported by Theory) 0.9976 Fri Apr 8 18:07:11 PDT 2011 [NEW FEATURES] - Support setting content_type in App::File (ajgb) [IMPROVEMENTS] - Document fixes (jhannah) - Skip bad tests failing on LWP 6 (daxim) 0.99_75 Thu Mar 24 11:29:22 PDT 2011 [INCOMPATIBLE CHANGES] - builder {} now always returns a PSGI code reference, instead of inconsistently returning URLMap object when mount() is used. (reported by hoelzro) - Plack::Runner now automatically calls ->parse_options() if it hasn't been called, so the sane defaults for plackup can be applied. (reported by arcanez) [BUG FIXES] - Fixed the way to override %ENV to avoid test breakages in Win32 #179 - Properly append '/' when linking to a directory in Plack::App::Directory (theory) [IMPROVEMENTS] - Skips the current directory in Plack::App::Directory - Plack::App::Directory now redirects to a canonical URL that has a trailing slash just like Apache (hobbs) - Fixed some typos and outdated information in the PODs 0.9974 Thu Mar 3 20:55:28 PST 2011 - Added a documentation about using relative URI paths beginning with // - Added IIS6ScriptNameFix that fixes SCRIPT_NAME for IIS6 FastCGI, extracted from Catalyst (rafl) - Moved the wrapcgi/exec tests for Win32 #174 - Fixed a warning for the new Test::TCP in FCGI testing - Clear %ENV when running the Plack::Test::Suite with Server implementation (hachi) 0.9973 Sat Feb 26 09:40:15 PST 2011 - Fixed the regexp in the code check added in 0.9972 (leedo) 0.9972 Thu Feb 24 10:50:01 PST 2011 - Fixed the Plack::Runner docs to avoid the cargo cult issue of __FILE__ eq $0 - Added a silly check to give warnings if the idiom __FILE__ eq $0 is used in .psgi 0.9971 Wed Feb 23 14:02:35 PST 2011 [INCOMPATIBLE CHANGES] - Localize $0 to the given .psgi path when evaluating it in Plack::Util::load_psgi() This fixes the unexpected values and/or crashes with Starman when your application uses FindBin module. 0.9970 Tue Feb 22 08:35:50 PST 2011 - Apache2: Fixed a bug where dispatcher fails to parse first path when it begins with two or more slashes (clkao) 0.9969 Fri Feb 18 21:35:29 PST 2011 - Suppress the use of unlocalized $_ in Plack::Runner (mst) - Plack::Handler::Net::FastCGI is now removed from Plack core dist. It will be released as a separate distribution on CPAN. - Fixed Plack::Handler::Apache2 so that it can safely call log (Andy Wardley) - StackTrace: Display graceful fallback errors when $SIG{__DIE__} is overridden in the application (mkanat) 0.9968 Wed Feb 9 19:07:48 PST 2011 - Fixed Recursive middleware to rethrow unknown exceptions. #166 (reported by waba) - Document response_cb. #121 - Plack::Loader to print errors if it is really a compilation error - Fixed the Cascade app to work with all 404 responses with the streaming interface. #171 (reported by eevee) 0.9967 Tue Jan 25 14:26:37 PST 2011 - Fixed StackTrace to require D::ST::WithLexicals 0.08 that supports 'message' (doy) 0.9966 Tue Jan 25 12:00:25 PST 2011 - Fixed a memory leak in SimpleLogger (vti) - Support %v in AccessLog (Ranguard) - Force set CONTENT_LENGTH in req_to_psgi when $content is given to HTTP::Request (timbunce) #150 - Fixed a case where SCRIPT_NAME and PATH_INFO can both get empty in req_to_psgi (doy) #163 0.9965 Mon Jan 24 23:08:04 PST 2011 - Requires Devel::StackTrace 0.11 - Fixed a regression where StackTrace wasn't able to get the thrown exception as an error message (hachi) 0.9964 Mon Jan 24 16:29:08 PST 2011 - Various documentation improvements (miyagawa, schwern) - Improved the way it eliminates Plack::Middleware::StackTrace from its own stacktrace (Jonathan Swartz) 0.9963 Mon Jan 10 16:46:33 PST 2011 - Fixed fcgi.t for lighttpd < 1.4.23 (confound) 0.9962 Sat Jan 8 21:07:30 PST 2011 - Same fix as 0.9961 but works around the issues with Strawberry unarchiver 0.9961 Fri Jan 7 21:54:04 PST 2011 - Skip directory.t on win32 since the directory "stuff.." can't be created [RT:64545] 0.9960 Sat Dec 25 11:16:08 PST 2010 - FCGI: Fixed the regression in 0.9958 where PATH_INFO gets wrong value when hosted under a non-root path (ambs) - Improved the FastCGI and Apache2 test infrastructure to test SCRIPT_NAME values 0.9959 Tue Dec 21 11:38:08 PST 2010 - Apache2: Fixed the regression bug around LocationMatch caused by fixes in 0.9958 (cho45) 0.9958 Mon Dec 20 15:18:54 PST 2010 - Plack::Handler::Apache[12] now handles Authorization: header automatically, no need for mod_rewrite workaround anymore (cho45) - Fixed Apache[12] and FCGI where multiple forward slashes were munged (cho45) - Static: Added pass_through option to pass non-existent paths to the app. Fixing the docs to match with the code (beanz) #154 0.9957 Thu Dec 16 11:27:29 PST 2010 - Fixed warnings in Plack::Request cookie parsing (typester) - removed MethodOverride middleware. Now it is a standalone distribution on CPAN (theory) 0.9956 Thu Dec 9 19:32:46 PST 2010 - FastCGI: Fixed an empty PATH_INFO with mod_fastcgi (and possibly others) - FastCGI: Improved the automatic detection of the case when invoked from web server. #141 (reported by LeoNerd) - plackup: Document that -e 'enable ...' doesn't assume app.psgi when there's no argument. #106 (clkao) - Plack::App::FCGIDispatcher: Remove the Status: header #123 (reported by Htbaa) - Apache2: Work around issues where SCRIPT_NAME gets wrong when LocationMatch is used. #136 (reported by atiking) 0.9955 Thu Dec 9 18:02:50 PST 2010 - More fixes to a possible directory traversal 0.9954 Thu Dec 9 17:45:59 PST 2010 - Fixed a directory traversal bug in Plack::App::File etc. RT:63020 0.9953 Fri Dec 3 14:50:09 PST 2010 - Include the original error message in the StackTrace text output on console. This requires Devel::StackTrace 1.23 and Devel::StackTrace::WithLexicals 0.08 (optional) - Fixed AccessLog middleware to handle multiple dashes in %{} (Jiro) 0.9952 Thu Dec 2 14:03:48 PST 2010 - Fixed the potential deadlocks in WrapCGI's read/write pipe (typester) - Improved documentations on plackup -e - Fixed a potential DoS vulnerability in HTTP::Server::PSGI (kazuho) - Allows setting names of FCGI process with proc_title option (rafl) 0.9951 Mon Oct 25 13:50:33 PDT 2010 - Added Feersum to the benchmark script (stash) - Lint: fixed the body handle check to see if the file has getline() method (tokuhirom) - StackTrace: store the stacktrace in $env->{'plack.stacktrace.text'} and $env->{'plack.stacktrace.html'} (theory) - Added ->mount method to the Plack::Builder OO interface (franckcuny) - HTTPExceptions: Don't set an invalid Content-Length when the exception is not an object (ask) - ErrorDocument: Fixed wrong Content-Length header be set (ask) 0.9950 Thu Sep 30 14:11:33 PDT 2010 - Fixed typos in middleware docs (miyagawa, theory, tokuhirom) - App::Directory: fixed URL generation escape bug (chiba) - Middleware::JSONP: support callback parameter name (franck) 0.9949 Tue Sep 14 11:59:36 PDT 2010 - Fixed FCGI handler docs - Auth::Basic: Pass $env to the callback so .htpasswd based auth can be implemented with PATH_INFO (doy) 0.9948 Thu Sep 9 16:01:53 PDT 2010 - Fixed a bug introduced in 0.9947 where $req->upload loses the temporary files when Plack::Request object is instantiated multiple times. It could happen if one of the pre-processing middleware uses Plack::Request and then again in the application or frameworks. 0.9947 Thu Sep 9 02:26:14 PDT 2010 - Plack::Loader: Fixed a typo in ENV that prevents warnings messages in development - Added flymake temporary file in Restarter (hirose31) - Plack::Request: Fixed a bug that HTTP::Body temporary files were not cleaned up (plu) - Middleware::AccessLog: Fixed a bug where %{key}i ignores the value '0' (nekoya) 0.9946 Sat Aug 28 22:32:16 PDT 2010 - Fixes UUV warnings in Apache2 handler RT:60472 - Fixed various test failures due to dependencies 0.9945 Thu Aug 19 16:24:30 PDT 2010 - Support executing (non-perl) CGI scripts in CGIBin and WrapCGI - Fixed tests for win32 0.9944 Sun Aug 8 23:35:52 PDT 2010 - Fixed Restarter for Starlet where SIGTERM doesn't quit the process (chiba) 0.9943 Fri Jul 30 13:24:15 PDT 2010 - Updated Apache* handler so it could duck type on Loader (jnap) - Added --access-log to plackup (grantm) - Added support for streaming stdio in Net::FastCGI handler (chansen) 0.9942 Fri Jul 23 23:42:43 PDT 2010 - Allow passing FCGI manager object to Handler::FCGI (confound) - Call FCGI::Request::Finish() before pm_post_dispatch (confound) - Moved response_cb() to Plack::Util (confound) - re-enable WithLexicals now that PadWalker segfaults with 5.12 is fixed #98 0.9941 Thu Jul 8 18:17:30 PDT 2010 - Makes Lint not warn about ASCII-only strings with UTF8 flag because they're safe 0.9940 Fri Jul 2 23:37:51 PDT 2010 - Fixed META.yml 0.9939 Fri Jul 2 17:56:10 PDT 2010 - Improved middleware documentation (miyagawa, leedo, bobtfish) - Added a test about Transfer-Encoding with Content-Length: 0 (chiba) - Fixed NullLogger middleware (haarg) - Fixed Plack::Util inline object's can() (haarg) - Middleware::HTTPException now honors ->location method of the exception (frodwith) - Middleware::AccessLog: Fixes %D to be microsec so it's compatible to Apache #119 (cho45) - Fixed Plack::Request->uri when PATH_INFO conatins URI reserved characters #118 (leedo) 0.9938 Sun May 23 17:13:05 PDT 2010 - ErrorDocument: Added Content-Length to error responses (hachi) - Improved docs about conditional middleware loading - XSendfile: Updated (undocumented) environment key to switch frontend - Auth::Basic: Added notes about how to use it with Apache (mod_perl and CGI) [RT #57436] 0.9937 Fri May 14 23:11:27 PDT 2010 - Fixed -I broken in 0.9936 (juster) #114 0.9936 Fri May 14 15:58:02 PDT 2010 - Remove 'use lib "lib"' from plackup - Remove HTTP_CONTENT_* environment variables in FastCGI handlers to deal with buggy web servers. (Justin Davis) 0.9935 Wed May 5 15:17:06 PDT 2010 - Set an empty PATH_INFO if CGI environment doesn't set so (hachi) #109 - Fixed a possible weird combination of SCRIPT_NAME and PATH_INFO in CGI handlers - localize PATH_INFO and SCRIPT_NAME in App::File and subclasses #100 - updated COPYRIGHT notice for Debian - Middleware::StackTrace now displays text trace to psgi.errors like Rack::ShowExceptions (castaway, theorbtwo) - Middleware::StackTrace: Fixed the text stack trace format to be more readable 0.9934 Tue May 4 15:47:33 PDT 2010 - Added a test in CGIBin where binmode ":utf8" causes bad content-length #110 - Doc fix for the deprecated servers - Initialize Module::Refresh (hiratara) - Added mime_type to ErorrDocument (kakuno) 0.9933 Tue Apr 27 14:32:23 PDT 2010 - refactored the app.psgi loading error handling - Enable type checking of the app in Lint->wrap - allow plackup -e'...' - Disable FCGI::Client/Net::FastCGI test by default 0.9932 Mon Apr 19 15:23:55 JST 2010 - Enable Lint middleware by default in the development env - Lint middleware now validates $app on startup - Fixed documentations on middleware and handlers 0.9931 Fri Apr 16 23:52:27 PDT 2010 - replace kyoto.jpg test image file with smaller baybridge.jpg to strip down the tarball size from 2.5MB to 212KB. 0.9930 Tue Apr 13 20:18:06 PDT 2010 - Added Plack::Handler::Net::FastCGI (chansen) - Made Test::TCP a hard dependency since Plack::Test needs it - Added Delayed loader for Starlet and Starman (clkao) - Hide logger middleware from log4perl's caller stack (haarg) 0.9929 Wed Mar 31 00:33:10 PDT 2010 - Middleware::JSONP: Simplified code and does not support IO response body type - fcgi.t: skip tests with lighttpd < 1.4.17 per CPAN Testers #7040400 0.9928 Mon Mar 29 17:02:42 PDT 2010 - log_dispatch.t: require Log::Dispatch::Array 0.9927 Mon Mar 29 12:43:44 PDT 2010 - require newer Log::Dispatch (confound) - StackTrace: Encode exceptions in utf-8 in case they include wide characters #95 (tokuhirom) - StackTrace: Depends on a new Devel::StackTrace::AsHTML that escapes wide characters - StackTrace: Display stacktrace only if the thrown exception is a direct error #91 (frodwith) - StackTrace: Added 'force' option to force stacktrace in 500 errors - Avoid warnings when response_cb filter returns undef in ARRAY response body #92 (hiratara) - URLMap: Ignore port number if it matches with SERVER_PORT #90 (omega) - URLMap: Enable debug print with PLACK_URLMAP_DEBUG=1 #94 - JSONP: Fixed possible infinite-loop when using with IO response body (hiratara) - Fixed the compatiblity issues with FastCGI docs and tests with lighttpd 1.4.26 (tadam) - LighttpdScriptNameFix: Added 'script_name' option (tadam) 0.9926 Sun Mar 28 14:37:03 PDT 2010 - Added -v|--version option to plackup and the ability for Plack::Runner users to override 0.9925 Sat Mar 27 19:03:57 PDT 2010 - Make this a non-devel release 0.99_24 Sat Mar 27 13:31:51 PDT 2010 - Disable Devel::StackTrace::WithLexicals for now until PadWalker RT #55242 is fixed 0.99_23 Sat Mar 27 01:02:24 PDT 2010 - Dropped keep-alive code from HTTP::Server::PSGI now that Starlet clones the code - Special case --disable-* and --enable-* command line options in plackup and Plack::Runner 0.99_22 Thu Mar 25 19:48:08 PDT 2010 - INCOMPATIBLE: removed --max-workers option from the default standalone server. Now it gives you warnings and falls back to the single process mode. 0.99_21 Thu Mar 25 15:05:53 PDT 2010 - INCOMPATIBLE: removed a workaround for lighttpd SCRIPT_NAME bug in FCGI handler See http://github.com/plack/Plack/issues#issue/68 for details. - HTTPException now logs standard exceptions to psgi.errors - micro optimization for Plack::Request content() method 0.9920 Thu Mar 18 23:48:06 PDT 2010 - Fixed URL path prefix matching in URLMap (hiratara) - Fixed Plack::Request->content on GET with FastCGI servers (sunnavy) - Added new middleware Middleware::Head - Fixed localization bug in Plack-Util/load.t 0.9919 Wed Mar 17 22:50:09 PDT 2010 - Properly rethrow .psgi compilation errors 0.9918 Wed Mar 17 22:35:00 PDT 2010 - Load .psgi file in an unique package rather than Plack::Util to avoid namespace pollution gh-88 0.9917 Wed Mar 17 15:33:43 PDT 2010 - Added Plack::Handler::Apache2::Registry (hiratara) - Set default PLACK_ENV in Plack::Util::load_psgi 0.9916 Fri Mar 12 12:52:39 JST 2010 - Added support for a new (renamed) web server Corona - Document enable coderef in Plack::Middleware (clkao) - Middleware::StackTrace: Send plain text errors to clients that probably do not understand HTML like curl 0.9915 Mon Mar 8 18:22:33 JST 2010 - Fixed a dumb bug in Plack::Handler::Apache2, broken in 0.9914 (hiratara) - Added a warning if you misuse mount() 0.9914 Wed Mar 3 16:02:38 PST 2010 - Fixed psgix.io and nested closure for perl 5.8 (hiratara) - Added an inheritance friendly Apache2 interface (frodwith) - HTTP::Server::PSGI: Close client connection in the first run (hirose31) - Fixed Loader/auto.t to reset env var (gugod) 0.9913 Thu Feb 25 19:14:40 PST 2010 - Revive psgix.io in HTTP::Server::PSGI (hiratara) - Fix packaging issue 0.9912 Thu Feb 25 01:28:21 PST 2010 - Fixed the possible source of memory leak in middleware + streamer + HTTP::Server::PSGI with perl 5.8.x (hiratara) 0.9911 Tue Feb 23 01:55:04 PST 2010 - Removed psgix.io extension to fix streaming choke issue on HTTP::Server::PSGI (tomyhero) 0.9910 Mon Feb 22 19:03:17 PST 2010 - This is the first non-dev release since 0.99. Read all the change logs below. - Support streaming in JSONP (hiratara) - Fixed various handler docs (markstos) - Added Starman and Twiggy to benchmark script - INCOMPATIBLE: Loader now prefers Twiggy when AnyEvent is loaded - Implemented (experimental) psgix.io and psgix.input.buffered extensions - Fixed Plack::Request POST parser to use psgix.input.buffered for better performance - Added PLACK_ENV environment support in plackup #63 - Added HTTPExceptions middleware - Added Recursive middleware 0.99_05 Wed Feb 10 12:46:05 PST 2010 - Changed the Loader command line options to -L from -l - Runner now folds --host, --port and --socket to --listen and vice verca - Added -D and --daemonize to plackup/Runner standard options - Fixed FCGI handler to work with the new --listen and --daemonize option - Fixed a bug in static.t where it chdir's before loading modules - Renamed Writer to BufferedStreaming middleware and added docs - Support streaming apps in Shotgun loader - Falls back to Standalone handler when auto-detected backend is not available (hiratara) - Support chunked-input in HTTP::Request->to_psgi - Make the Reloader work with preforked server (chiba) - Added 'Auto' backend in TempBuffer - Added Nomo backend to the benchmark script - Updated HTTP::Server::PSGI to support experimental psgix.input.buffered - Plack::Request now honors psgix.input.buffered to see psgi.input is seekable - Renamed Standalone handler to HTTP::Server::PSGI for consistency while keeping 'Standalone' as a nickname 0.99_04 Fri Feb 5 23:10:48 PST 2010 - Updated Test suite for multiple request headers to relax a bit for AE::HTTPD - Added a test for large POST body which revealed FCGI::Client bug - Added a handler for HTTP::Server::Simple::PSGI - Depend on a decent version of URI (tomyhero) - Reworked Loader API so the default loader can autodetect the backend again - run_app now doesn't use Try::Tiny but use plain eval {} 0.99_03 Wed Feb 3 16:09:14 PST 2010 - Use 0 as a default address in the server_ready hook in Plack::Runner - Document Plack::Handler naming scheme - Fixed how Plack::Server::Standalone saves args - Supported streaming interface in Cascade and URLMap - mentions awesome WSGI Paste in Plack documentation - Removed URI caching in Plack::Request since it's fast enough - Fixed packaging issue due to Module::Install::Share bug (rafl) - Support 'file' option in App::File and its subclasses - Fixed SCRIPT_NAME and PATH_INFO in App::CGIBin - Fixed App::Directory and ::File not to use Path::Class and its canonicalization. It's now 300% faster! 0.99_02 Sat Jan 30 22:10:45 PST 2010 - Fixed Plack::TempBuffer to work with 5.8 and 5.11.3 - Do not use <$input> in FCGIDispatcher - Skip fcgi_client.t unless explicitly stated (clkao) - clarify and drop some CPAN dependencies (andk) 0.99_01 Fri Jan 29 14:02:04 PST 2010 Incompatible Changes - Rename Standalone servers to HTTP::Server::PSGI - Rename Plack::Server adapters to Plack::Handler. These changes should be transparnt since we have a compatible code to work with the older names as well. - Dropped sendfile(2) AIO support from Standalone server - Plack::Request and Response are now in core, deprecating many methods. Read `perldoc Plack::Request` and its INCOMPATIBILITIES section New Features - New middleware: WrapCGI to convert a single CGI script into a PSGI applciation - Support psgix.logger and psgix.session in Plack::Request - New logger middleware: NullLogger, SimpleLogger, Log4perl and LogDispatch - Refactored Loader classes and added a new Shotgun loader (like rack's Shotgun) - Added -l option to plackup which specifies the Loader backend - New middleware: Refresh reloads modules in %INC in every N seconds - Wraps -e code with 'builder { }' by default. You can also use with *.psgi to add middleware components without editing the file! Bug Fixes and Improvements - Do not call ->canonical in HTTP::Message::PSGI to keep the URI encoded params in Plack::Test tests (rafl, t0m) - Fixed a bug in stupid corner case in HTTP::Message::PSGI where passed URI has UTF-8 encoded strings *and* URI escaped UTF-8 bytes. (chmrr) - Depend on new HTTP::Request::AsCGI that has better REQUEST_URI - Plack::Runner/plackup does not autoload AccessLog in CGI mode anymore - Added server_ready hook to PSGI servers so you can disable them in tests etc. (clkao, rafl) - Escape user-supplied values in AccessLog to avoid control sequence injection (tokuhirom, kazuho) - Support -foo (single dash) style option in Plack::Runner and plackup - Relax the runtime.t check since it still fails on low-res time environments - Now depends on Digest::MD5, HTTP::Body and Hash::MultiValue - Revert the 'require' in load_psgi to do 'do' - Delay load unnecessary modules in Plack::Runner - Fixed psgi.multiprocess value on HTTP::Server::PSGI - PSGI/1.1 support in Lint 0.9031 Mon Jan 11 11:29:04 PST 2010 - Fixed Plack::App::Directory directory listing by switching to Plack::MIME (tokuhirom) This has been broken since 0.9025 - Fixed body filtering middleware such as Plack::Middleware::Deflater (hiratara) This has been broken since 0.9026 0.9030 Sat Jan 9 13:13:17 PST 2010 - Support streaming interface in HTTP::Message::PSGI, Lint and Plack::Test (rafl) - plackup -e doesn't enable strict and warnings by default, like perl - Improved Middleware::Auth::Basic performance and error check 0.9029 Thu Jan 7 19:09:17 PST 2010 - Fixed runtime.t to relax test condition to avoid failures on Win32 (xaicron) - Fixed a bug in FCGI engine where it creates a bogus response when running under a buffered I/O with lighttpd. (fcharlier, typester) - FCGI and CGI server now autoflushes STDOUT to do non-buffering output - Fixed a Plack::MIME bug where extensions like .mp3 fails 0.9028 Tue Jan 5 18:42:07 PST 2010 - Fixed a long standing bug where errors are not printed correctly when the application dies. (tokuhirom) - Fixed FCGIClient passing bogus psgi.* environment values to the backend - Implemented psgi.streaming in all blocking servers (miyagawa, rafl) 0.9027 Sun Jan 3 16:33:23 PST 2010 - Added new middleware Runtime that adds X-Runtime header - Delay load Pod::Usage in Plack::Runner and plackup 0.9026 Fri Jan 1 10:35:26 JST 2010 - Auth::Basic now accepts an object that duck types to ->authenticate (e.g. Authen::Simple) - Reworked how response_cb body callback works, so Content-Length will be updated correctly 0.9025 Sat Dec 26 10:11:59 JST 2009 - Server::Standalone::* should now display the correct Server: value - Fixed a bug in AccessLog::Timed where %D and %T do not work - Fixed a bug in AccessLog::Timed to work with filehandles - Removed a dependency to MIME::Types and include Plack::MIME - Refactored plackup into Plack::Runner - Fixed a failing test under stupid Win32 filesystem - Fixed ConditionalGET to work with delayed response 0.9024 Sat Dec 19 12:25:52 PST 2009 - Overwhauled how -r and -R works in plackup. Looks at .psgi and lib/ under that by default. 0.9023 Thu Dec 17 13:16:38 PST 2009 - Document the use of Plack:: namespace - Use safer Unicode characters in tests to silence warnings #66 - Plack::Util::load_psgi now takes a class name as well. Added notes about the security of its use - Set default host in MockHTTP and keep them if explicitly set (nihen) 0.9022 Sun Dec 13 10:53:01 PST 2009 - Added more assertions to Middleware::Lint - Added a new test to test big HTTP header, which reveals the FCGI::Client bug (zrail, tokuhirom) - plackup -e now automatically loads Plack::Builder - Fixed fcgi tests (tokuhirom) - Fixed Test::MockHTTP to make 500 response when the app died - Fixed a memory leak in StackTrace when WithLexicals is used (chiba, Sartak) - Fixed Middleware::ConditionalGET to deal with stupid IE headers (chiba) - Fixed lots of typos (Sartak) 0.9021 Tue Dec 8 14:29:08 PST 2009 - Doc patches to Plack about CONTRIBUTING (stevan) - Remove Class::Accessor::Fast and added Plack::Util::Accessor (stevan) - Added Plack::Component the common base class for both App:: and Middleware (stevan) - Plack::Test test_psgi now accepts $app, $client in positional args - Plack::Test client callback can now omit host names like $cb->(GET "/") 0.9020 Mon Dec 7 10:38:37 GMT 2009 - Fixed a test (psgibin.t) failure in case sensitive filesystem - Fixed a warning in Plack::Util::header_set 0.9019 Sun Dec 6 05:56:30 GMT 2009 - Fixed a bug in Plack::Util::header_set when to clear multiple headers (chiba) - Added Plack::App::CGIBin that runs cgi-bin scripts as a PSGI application - Added Plack::App::PSGIBin that loads .psgi files from local filesystem 0.9018 Thu Dec 3 00:48:04 PST 2009 - Allow Plack::Middleware->new to accept plain hashes - Added Plack::App::Cascade to create a compound apps that cascade requests - Added POE backend to benchmarks/ab.pl - Implemented Plack::Server::Apache[12]->preload to preload apps in or startup file 0.9017 Sun Nov 29 17:33:36 JST 2009 - Fixed more tests that fail on Win32 (charsbar) 0.9016 Sun Nov 29 16:39:40 JST 2009 - removed Middleware::Deflater from the dist. - Fixed Standalone so as not to use Time::HiRes::Alarm on Win32 systems (charsbar, kazuho) - Fixed App::File to set file path using forward slashes on Win32 (charsbar) #49 0.9015 Thu Nov 26 17:31:33 JST 2009 - Fixed a bug in URLMap where $env is shallow copied and some middleware don't work - Added -e and -M to plackup - plackup -r with args (directories to watch) is deprecated. Use -R instead - plackup foo.psgi now DWIMs. -a (--app) continues to work - Optimizaitons to Middleware and docs to explicitly call to_app because overloading happens every request and is inefficient. - The abilitiy to auto-select server backends for POE/AnyEvent/Coro is restored. Doesn't work with -r though. #50 - Display server package name in the Standalone/Prefork startup - Fixed a bug in Plack::Test::MockHTTP where $res doesn't return the request (teejay) - Fixed a bug in URLMap where requests to / fails in some cases (chiba) 0.9014 Fri Nov 20 21:51:47 PST 2009 - Updated docs for Standalone keep-alive options - Added Auth::Basic middleware - Fixed dependencies and MakeMaker issues in the archive 0.9013 Wed Nov 18 18:26:31 PST 2009 - Disable keep-alive in Standalone by default (kazuho, frew) - Fixed a bug in Standalone where 'timeout' property is ignored in the first request (kazuho) - Fixed a documentation bug in Middleware::Conditional (confound, scook) 0.9012 Tue Nov 17 13:38:38 PST 2009 - Added Middleware::Conditional and enable_if DSL for dynamic builder (scook) 0.9011 Thu Nov 12 03:53:28 PST 2009 - Added Apache1 support (Aaron Trevena) 0.9010 Wed Nov 11 23:18:37 PST 2009 - You can now omit Plack::Middleware:: in Builder DSL's enable() 0.9009 Sat Nov 7 20:43:17 PST 2009 - Fixed dependencies for tests 0.9008 Tue Oct 27 14:15:28 PDT 2009 - Removed optional deps from Makefile.PL and moved them to Task::Plack (mst) - Make some middleware deps as required to make it simple, for now 0.9007 Sat Oct 24 17:41:33 PDT 2009 - Fixed Server::CGI to really inline fuctions to avoid warnings - Fixed Middleware::AccessLog to let %{..}t strftime log format work (beppu) - Fixed a flush bug in gzip encoding in Middleware::Deflater - Fixed a bug in Middleware::AccessLog so POSIX strftime always works in English (fayland) - Added Middleware::ContentMD5 (Fayland) - Fixed plackup -r to actually reload the application code (robinsmidsrod) 0.9006 Fri Oct 23 01:21:13 PDT 2009 - Support streaming interface in most middlewares - Added Middleware::Deflater (not recommended to use: see POD) - Document FCGI configuration in Server::FCGI pod (dhoss) - Inline Plack::Util functions in Server::CGI to speed up (mst) 0.9005 Wed Oct 21 20:53:19 PDT 2009 - Switch to Filesys::Notify::Simple to watch directory to trim down deps - Made some dependencies optional since they're actually optional 0.9004 Tue Oct 20 22:57:48 PDT 2009 - Fixed File::ShareDir dependency (mst) - App::File and Middleware::Static now auto follows symlinks (chiba) - Implemented plackup -r as Plack::Loader::Reloadable (nothingmuch) - Removed poll_cb from Writer middleware - Added plackup common command line options: -o for --host and -p for --port 0.9003 Sun Oct 18 19:16:26 PDT 2009 - Added POE to Plack::Loader autoload - Implemented callback style streaming in selected middlewares - Bump up HTTP::Parser::XS to fix memory leaks - Added Middleware::Chunked - Added Middleware::JSONP - Added twitter-stream.psgi example to do streaming server push - Fixed Middleware::StackTrace to DWIM in framework generated 500 errors - Fixed Restarter to do what doc says 0.9002 Wed Oct 14 11:26:28 PDT 2009 - Added a workaround in Server::Apache2 when Location and SCRIPT_NAME don't match - Use Try::Tiny and parent for smaller memory footprint and better error handling 0.9001 Tue Oct 13 00:55:34 PDT 2009 - Downgrade EUMM in inc/ 0.9000 Tue Oct 13 00:14:01 PDT 2009 - original version Plack-1.0039/cpanfile000644 000765 000024 00000002413 12631015706 015307 0ustar00miyagawastaff000000 000000 requires 'perl', '5.008001'; requires 'Cookie::Baker', '0.05'; requires 'Devel::StackTrace', '1.23'; requires 'Devel::StackTrace::AsHTML', '0.11'; requires 'File::ShareDir', '1.00'; requires 'Filesys::Notify::Simple'; requires 'HTTP::Body', '1.06'; requires 'HTTP::Message', '5.814'; requires 'HTTP::Headers::Fast', '0.18'; requires 'Hash::MultiValue', '0.05'; requires 'Pod::Usage', '1.36'; requires 'Stream::Buffered', '0.02'; requires 'Test::TCP', '2.00'; requires 'Try::Tiny'; requires 'URI', '1.59'; requires 'parent'; requires 'Apache::LogFormat::Compiler', '0.12'; requires 'HTTP::Tiny', 0.034; on test => sub { requires 'Test::More', '0.88'; requires 'Test::Requires'; suggests 'Authen::Simple::Passwd'; suggests 'MIME::Types'; suggests 'CGI::Emulate::PSGI'; suggests 'CGI::Compile'; suggests 'IO::Handle::Util'; suggests 'LWP::Protocol::http10'; suggests 'Log::Log4perl'; suggests 'HTTP::Server::Simple::PSGI'; suggests 'HTTP::Request::AsCGI'; suggests 'LWP::UserAgent', '5.814'; suggests 'Module::Refresh'; }; on runtime => sub { suggests 'FCGI'; suggests 'FCGI::ProcManager'; suggests 'CGI::Emulate::PSGI'; suggests 'CGI::Compile'; suggests 'IO::Handle::Util'; suggests 'LWP::UserAgent', '5.814'; }; Plack-1.0039/dist.ini000644 000765 000024 00000000107 12631015706 015245 0ustar00miyagawastaff000000 000000 [@Milla] installer = MakeMaker [Metadata] x_authority = cpan:MIYAGAWA Plack-1.0039/eg/000755 000765 000024 00000000000 12631015706 014176 5ustar00miyagawastaff000000 000000 Plack-1.0039/lib/000755 000765 000024 00000000000 12631015706 014351 5ustar00miyagawastaff000000 000000 Plack-1.0039/LICENSE000644 000765 000024 00000043716 12631015706 014623 0ustar00miyagawastaff000000 000000 This software is copyright (c) 2009-2013 by Tatsuhiko Miyagawa. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2009-2013 by Tatsuhiko Miyagawa. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2009-2013 by Tatsuhiko Miyagawa. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Plack-1.0039/Makefile.PL000644 000765 000024 00000005337 12631015706 015565 0ustar00miyagawastaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.042. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; use File::ShareDir::Install; $File::ShareDir::Install::INCLUDE_DOTFILES = 1; $File::ShareDir::Install::INCLUDE_DOTDIRS = 1; install_share dist => "share"; my %WriteMakefileArgs = ( "ABSTRACT" => "Perl Superglue for Web frameworks and Web Servers (PSGI toolkit)", "AUTHOR" => "Tatsuhiko Miyagawa", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::ShareDir::Install" => "0.06" }, "DISTNAME" => "Plack", "EXE_FILES" => [ "script/plackup" ], "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008001", "NAME" => "Plack", "PREREQ_PM" => { "Apache::LogFormat::Compiler" => "0.12", "Cookie::Baker" => "0.05", "Devel::StackTrace" => "1.23", "Devel::StackTrace::AsHTML" => "0.11", "File::ShareDir" => "1.00", "Filesys::Notify::Simple" => 0, "HTTP::Body" => "1.06", "HTTP::Headers::Fast" => "0.18", "HTTP::Message" => "5.814", "HTTP::Tiny" => "0.034", "Hash::MultiValue" => "0.05", "Pod::Usage" => "1.36", "Stream::Buffered" => "0.02", "Test::TCP" => "2.00", "Try::Tiny" => 0, "URI" => "1.59", "parent" => 0 }, "TEST_REQUIRES" => { "Test::More" => "0.88", "Test::Requires" => 0 }, "VERSION" => "1.0039", "test" => { "TESTS" => "t/*.t t/HTTP-Message-PSGI/*.t t/HTTP-Server-PSGI/*.t t/Plack-Builder/*.t t/Plack-HTTPParser-PP/*.t t/Plack-Handler/*.t t/Plack-Loader/*.t t/Plack-MIME/*.t t/Plack-Middleware/*.t t/Plack-Middleware/cascade/*.t t/Plack-Middleware/recursive/*.t t/Plack-Middleware/stacktrace/*.t t/Plack-Request/*.t t/Plack-Response/*.t t/Plack-Runner/*.t t/Plack-TempBuffer/*.t t/Plack-Test/*.t t/Plack-Util/*.t" } ); my %FallbackPrereqs = ( "Apache::LogFormat::Compiler" => "0.12", "Cookie::Baker" => "0.05", "Devel::StackTrace" => "1.23", "Devel::StackTrace::AsHTML" => "0.11", "File::ShareDir" => "1.00", "Filesys::Notify::Simple" => 0, "HTTP::Body" => "1.06", "HTTP::Headers::Fast" => "0.18", "HTTP::Message" => "5.814", "HTTP::Tiny" => "0.034", "Hash::MultiValue" => "0.05", "Pod::Usage" => "1.36", "Stream::Buffered" => "0.02", "Test::More" => "0.88", "Test::Requires" => 0, "Test::TCP" => "2.00", "Try::Tiny" => 0, "URI" => "1.59", "parent" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); { package MY; use File::ShareDir::Install qw(postamble); } Plack-1.0039/MANIFEST000644 000765 000024 00000017344 12631015706 014745 0ustar00miyagawastaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.042. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README benchmarks/ab.pl benchmarks/fcgi.pl cpanfile dist.ini eg/dot-psgi/Dumper.psgi eg/dot-psgi/Hello.psgi eg/dot-psgi/cgi-pm.psgi eg/dot-psgi/cgi-script.psgi eg/dot-psgi/echo-stream-sync.psgi eg/dot-psgi/echo-stream.psgi eg/dot-psgi/echo.psgi eg/dot-psgi/error.psgi eg/dot-psgi/image.psgi eg/dot-psgi/nonblock-hello.psgi eg/dot-psgi/plack-req.psgi eg/dot-psgi/runnable.psgi eg/dot-psgi/slowapp.psgi eg/dot-psgi/static.psgi eg/dot-psgi/static/index.html eg/dot-psgi/static/test.css eg/dot-psgi/static/test.js eg/dot-psgi/twitter-stream.psgi lib/HTTP/Message/PSGI.pm lib/HTTP/Server/PSGI.pm lib/Plack.pm lib/Plack/App/CGIBin.pm lib/Plack/App/Cascade.pm lib/Plack/App/Directory.pm lib/Plack/App/File.pm lib/Plack/App/PSGIBin.pm lib/Plack/App/URLMap.pm lib/Plack/App/WrapCGI.pm lib/Plack/Builder.pm lib/Plack/Component.pm lib/Plack/HTTPParser.pm lib/Plack/HTTPParser/PP.pm lib/Plack/Handler.pm lib/Plack/Handler/Apache1.pm lib/Plack/Handler/Apache2.pm lib/Plack/Handler/Apache2/Registry.pm lib/Plack/Handler/CGI.pm lib/Plack/Handler/FCGI.pm lib/Plack/Handler/HTTP/Server/PSGI.pm lib/Plack/Handler/Standalone.pm lib/Plack/LWPish.pm lib/Plack/Loader.pm lib/Plack/Loader/Delayed.pm lib/Plack/Loader/Restarter.pm lib/Plack/Loader/Shotgun.pm lib/Plack/MIME.pm lib/Plack/Middleware.pm lib/Plack/Middleware/AccessLog.pm lib/Plack/Middleware/AccessLog/Timed.pm lib/Plack/Middleware/Auth/Basic.pm lib/Plack/Middleware/BufferedStreaming.pm lib/Plack/Middleware/Chunked.pm lib/Plack/Middleware/Conditional.pm lib/Plack/Middleware/ConditionalGET.pm lib/Plack/Middleware/ContentLength.pm lib/Plack/Middleware/ContentMD5.pm lib/Plack/Middleware/ErrorDocument.pm lib/Plack/Middleware/HTTPExceptions.pm lib/Plack/Middleware/Head.pm lib/Plack/Middleware/IIS6ScriptNameFix.pm lib/Plack/Middleware/IIS7KeepAliveFix.pm lib/Plack/Middleware/JSONP.pm lib/Plack/Middleware/LighttpdScriptNameFix.pm lib/Plack/Middleware/Lint.pm lib/Plack/Middleware/Log4perl.pm lib/Plack/Middleware/LogDispatch.pm lib/Plack/Middleware/NullLogger.pm lib/Plack/Middleware/RearrangeHeaders.pm lib/Plack/Middleware/Recursive.pm lib/Plack/Middleware/Refresh.pm lib/Plack/Middleware/Runtime.pm lib/Plack/Middleware/SimpleContentFilter.pm lib/Plack/Middleware/SimpleLogger.pm lib/Plack/Middleware/StackTrace.pm lib/Plack/Middleware/Static.pm lib/Plack/Middleware/XFramework.pm lib/Plack/Middleware/XSendfile.pm lib/Plack/Request.pm lib/Plack/Request/Upload.pm lib/Plack/Response.pm lib/Plack/Runner.pm lib/Plack/TempBuffer.pm lib/Plack/Test.pm lib/Plack/Test/MockHTTP.pm lib/Plack/Test/Server.pm lib/Plack/Test/Suite.pm lib/Plack/Util.pm lib/Plack/Util/Accessor.pm script/plackup share/#foo share/baybridge.jpg share/face.jpg t/FCGIUtils.pm t/HTTP-Message-PSGI/content_length.t t/HTTP-Message-PSGI/empty_streamed_response.t t/HTTP-Message-PSGI/host.t t/HTTP-Message-PSGI/path_info.t t/HTTP-Message-PSGI/unknown_response.t t/HTTP-Message-PSGI/utf8_req.t t/HTTP-Server-PSGI/harakiri.t t/HTTP-Server-PSGI/post.t t/Plack-Builder/builder.t t/Plack-Builder/mount.t t/Plack-Builder/oo_interface.t t/Plack-HTTPParser-PP/simple.t t/Plack-Handler/apache1.t t/Plack-Handler/apache2-registry.t t/Plack-Handler/apache2.t t/Plack-Handler/cgi.t t/Plack-Handler/fcgi.t t/Plack-Handler/output_encoding.t t/Plack-Handler/standalone.t t/Plack-Handler/try_mangle.pl t/Plack-Loader/auto.t t/Plack-Loader/auto_fallback.t t/Plack-Loader/delayed.t t/Plack-Loader/restarter.t t/Plack-Loader/restarter_valid.t t/Plack-Loader/shotgun.t t/Plack-MIME/add_type.t t/Plack-MIME/basic.t t/Plack-MIME/fallback.t t/Plack-Middleware/access_log.t t/Plack-Middleware/access_log_timed.t t/Plack-Middleware/access_log_value_zero.t t/Plack-Middleware/auth_basic.t t/Plack-Middleware/auth_basic_env.t t/Plack-Middleware/auth_basic_simple.t t/Plack-Middleware/bufferedstreaming.t t/Plack-Middleware/cascade/basic.t t/Plack-Middleware/cascade/streaming.t t/Plack-Middleware/cgi-bin/cgi_dir.cgi t/Plack-Middleware/cgi-bin/hello.cgi t/Plack-Middleware/cgi-bin/hello.py t/Plack-Middleware/cgi-bin/hello2.cgi t/Plack-Middleware/cgi-bin/hello3.cgi t/Plack-Middleware/cgi-bin/utf8.cgi t/Plack-Middleware/cgibin.t t/Plack-Middleware/cgibin_exec.t t/Plack-Middleware/chunked.t t/Plack-Middleware/component-leak.t t/Plack-Middleware/component.t t/Plack-Middleware/conditional.t t/Plack-Middleware/conditional_new.t t/Plack-Middleware/conditionalget.t t/Plack-Middleware/conditionalget_writer.t t/Plack-Middleware/content_length.t t/Plack-Middleware/directory.t t/Plack-Middleware/error_document.t t/Plack-Middleware/error_document_streaming_app.t t/Plack-Middleware/errors/404.html t/Plack-Middleware/errors/500.html t/Plack-Middleware/file.t t/Plack-Middleware/head.t t/Plack-Middleware/head_streaming.t t/Plack-Middleware/htpasswd t/Plack-Middleware/httpexceptions.t t/Plack-Middleware/httpexceptions_streaming.t t/Plack-Middleware/iis6_script_name_fix.t t/Plack-Middleware/iis7_keep_alive_fix.t t/Plack-Middleware/jsonp.t t/Plack-Middleware/lint.t t/Plack-Middleware/lint_env.t t/Plack-Middleware/lint_utf8_false_alarm.t t/Plack-Middleware/log4perl-category.t t/Plack-Middleware/log4perl.t t/Plack-Middleware/log_dispatch.t t/Plack-Middleware/order.t t/Plack-Middleware/prefix.t t/Plack-Middleware/psgibin.t t/Plack-Middleware/rearrange_headers.t t/Plack-Middleware/recursive/base.t t/Plack-Middleware/recursive/streaming.t t/Plack-Middleware/recursive/throw.t t/Plack-Middleware/recursive/throw_streaming.t t/Plack-Middleware/refresh-init.t t/Plack-Middleware/runtime.t t/Plack-Middleware/simple_content_filter.t t/Plack-Middleware/simple_logger.t t/Plack-Middleware/stacktrace/basic.t t/Plack-Middleware/stacktrace/force.t t/Plack-Middleware/stacktrace/multiple_exceptions.t t/Plack-Middleware/stacktrace/sigdie.t t/Plack-Middleware/stacktrace/streaming.t t/Plack-Middleware/stacktrace/utf8.t t/Plack-Middleware/static.foo t/Plack-Middleware/static.t t/Plack-Middleware/static.txt t/Plack-Middleware/static_env.t t/Plack-Middleware/urlmap.t t/Plack-Middleware/urlmap_builder.t t/Plack-Middleware/urlmap_env.t t/Plack-Middleware/urlmap_ports.t t/Plack-Middleware/wrapcgi.t t/Plack-Middleware/wrapcgi_exec.t t/Plack-Middleware/xframework.t t/Plack-Middleware/xsendfile.t t/Plack-Request/base.t t/Plack-Request/body.t t/Plack-Request/content-on-get.t t/Plack-Request/content.t t/Plack-Request/cookie.t t/Plack-Request/double_port.t t/Plack-Request/foo1.txt t/Plack-Request/foo2.txt t/Plack-Request/hostname.t t/Plack-Request/many_upload.t t/Plack-Request/multi_read.t t/Plack-Request/new.t t/Plack-Request/parameters.t t/Plack-Request/params.t t/Plack-Request/path_info.t t/Plack-Request/path_info_escaped.t t/Plack-Request/query_string.t t/Plack-Request/readbody.t t/Plack-Request/request_uri.t t/Plack-Request/upload-basename.t t/Plack-Request/upload-large.t t/Plack-Request/upload.t t/Plack-Request/uri.t t/Plack-Request/uri_utf8.t t/Plack-Response/body.t t/Plack-Response/compatible.t t/Plack-Response/cookie.t t/Plack-Response/new.t t/Plack-Response/redirect.t t/Plack-Response/response.t t/Plack-Response/to_app.t t/Plack-Runner/options.t t/Plack-Runner/path.t t/Plack-TempBuffer/print.t t/Plack-Test/2args.t t/Plack-Test/cookie.t t/Plack-Test/hello.t t/Plack-Test/hello_server.t t/Plack-Test/suite.t t/Plack-Util/Hello.pm t/Plack-Util/bad.psgi t/Plack-Util/bad2.psgi t/Plack-Util/bin/findbin.psgi t/Plack-Util/can.t t/Plack-Util/error.psgi t/Plack-Util/foreach.t t/Plack-Util/header_exists.t t/Plack-Util/header_get.t t/Plack-Util/header_push.t t/Plack-Util/header_remove.t t/Plack-Util/header_set.t t/Plack-Util/headers_obj.t t/Plack-Util/hello.psgi t/Plack-Util/inc/hello.psgi t/Plack-Util/inline_object.t t/Plack-Util/io_with_path.t t/Plack-Util/is_real_fh.t t/Plack-Util/load.t t/Plack-Util/response_cb.t t/author-pod-syntax.t t/test.txt xt/author-downstream.t Plack-1.0039/META.json000644 000765 000024 00000017370 12631015706 015234 0ustar00miyagawastaff000000 000000 { "abstract" : "Perl Superglue for Web frameworks and Web Servers (PSGI toolkit)", "author" : [ "Tatsuhiko Miyagawa" ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.042, Dist::Milla version v1.0.15, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Plack", "no_index" : { "directory" : [ "eg", "examples", "inc", "share", "t", "xt" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "File::ShareDir::Install" : "0.06" } }, "develop" : { "requires" : { "Dist::Milla" : "v1.0.15", "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Apache::LogFormat::Compiler" : "0.12", "Cookie::Baker" : "0.05", "Devel::StackTrace" : "1.23", "Devel::StackTrace::AsHTML" : "0.11", "File::ShareDir" : "1.00", "Filesys::Notify::Simple" : "0", "HTTP::Body" : "1.06", "HTTP::Headers::Fast" : "0.18", "HTTP::Message" : "5.814", "HTTP::Tiny" : "0.034", "Hash::MultiValue" : "0.05", "Pod::Usage" : "1.36", "Stream::Buffered" : "0.02", "Test::TCP" : "2.00", "Try::Tiny" : "0", "URI" : "1.59", "parent" : "0", "perl" : "5.008001" }, "suggests" : { "CGI::Compile" : "0", "CGI::Emulate::PSGI" : "0", "FCGI" : "0", "FCGI::ProcManager" : "0", "IO::Handle::Util" : "0", "LWP::UserAgent" : "5.814" } }, "test" : { "requires" : { "Test::More" : "0.88", "Test::Requires" : "0" }, "suggests" : { "Authen::Simple::Passwd" : "0", "CGI::Compile" : "0", "CGI::Emulate::PSGI" : "0", "HTTP::Request::AsCGI" : "0", "HTTP::Server::Simple::PSGI" : "0", "IO::Handle::Util" : "0", "LWP::Protocol::http10" : "0", "LWP::UserAgent" : "5.814", "Log::Log4perl" : "0", "MIME::Types" : "0", "Module::Refresh" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/plack/Plack/issues" }, "homepage" : "https://github.com/plack/Plack", "repository" : { "type" : "git", "url" : "https://github.com/plack/Plack.git", "web" : "https://github.com/plack/Plack" } }, "version" : "1.0039", "x_authority" : "cpan:MIYAGAWA", "x_contributors" : [ "Aaron Trevena ", "Ævar Arnfjörð Bjarmason ", "Alexandr Ciornii ", "Alex J. G. BurzyÅ„ski ", "Allan Whiteford ", "Andrew Rodland ", "Andy Wardley ", "Aristotle Pagaltzis ", "Arthur Axel 'fREW' Schmidt ", "Ashley Pond V ", "Ask Bjørn Hansen ", "Ben Morrow ", "Bernhard Graf ", "Chad Granum ", "chansen ", "Chia-liang Kao ", "cho45 ", "Christian Walde ", "chromatic ", "Cosimo Streppone ", "Daisuke Maki ", "Daisuke Murase ", "Dave Marr ", "Dave Rolsky ", "David E. Wheeler ", "David Steinbrunner ", "Eduardo Arino de la Rubia ", "Eric Johnson ", "Eugen Konkov ", "Fabrice Gabolde ", "fayland ", "Flavio Poletti ", "Florian Ragwitz ", "franck cuny ", "Graham Knop ", "Grant McLean ", "Hans Dieter Pearcey ", "Haruka Iwao ", "Henry Baragar ", "hiratara ", "HIROSE Masaaki ", "Hiroshi Sakai ", "Ian Bradley ", "Ian Burrell ", "Jakob Voss ", "Jakob Voss ", "Jay Hannah ", "Jesse Luehrs ", "Jiro Nishiguchi ", "Johannes Plunien ", "John Beppu ", "John Napiorkowski ", "Jonathan Swartz ", "JoseÌ Pinheiro Neta ", "Justin Davis ", "kakuno ", "Kang-min Liu ", "Karen Etheridge ", "Kazuho Oku ", "Keedi Kim ", "Lee Aylward ", "Leo Lapworth ", "mala ", "Marian Schubert ", "Mark Fowler ", "Mark Stosberg ", "Masahiro Chiba ", "Masahiro Nagano ", "Michael G. Schwern ", "mickey ", "Nick Wellnhofer ", "Nobuo Danjou ", "Olaf Alders ", "Oliver Gorwits ", "Oliver Paukstadt ", "Oliver Trosien ", "Olivier Mengué ", "osfameron ", "Panu Ervamaa ", "Paul Driver ", "Pedro Melo ", "Peter Flanigan ", "Peter Makholm ", "Piotr Roszatycki ", "punytan ", "Rafael Kitover ", "Randy Stauner ", "Ray Miller ", "Ricky Morse ", "Rob Hoelz ", "Ryo Miyake ", "Sawyer X ", "Scott S. McCoy ", "Shawn M Moore ", "Stephen Clouse ", "Stevan Little ", "Stuart A Johnston ", "Takeshi OKURA ", "Tatsuhiko Miyagawa ", "Tim Bunce ", "Tokuhiro Matsuno ", "Tomas Doran ", "Tom Heady ", "vti ", "Wallace Reis ", "xaicron ", "Yann Kerherve ", "yappo ", "Yury Zavarin ", "Yuval Kogman ", "å”é³³ " ] } Plack-1.0039/META.yml000644 000765 000024 00000013365 12631015706 015064 0ustar00miyagawastaff000000 000000 --- abstract: 'Perl Superglue for Web frameworks and Web Servers (PSGI toolkit)' author: - 'Tatsuhiko Miyagawa' build_requires: Test::More: '0.88' Test::Requires: '0' configure_requires: ExtUtils::MakeMaker: '0' File::ShareDir::Install: '0.06' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.042, Dist::Milla version v1.0.15, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Plack no_index: directory: - eg - examples - inc - share - t - xt requires: Apache::LogFormat::Compiler: '0.12' Cookie::Baker: '0.05' Devel::StackTrace: '1.23' Devel::StackTrace::AsHTML: '0.11' File::ShareDir: '1.00' Filesys::Notify::Simple: '0' HTTP::Body: '1.06' HTTP::Headers::Fast: '0.18' HTTP::Message: '5.814' HTTP::Tiny: '0.034' Hash::MultiValue: '0.05' Pod::Usage: '1.36' Stream::Buffered: '0.02' Test::TCP: '2.00' Try::Tiny: '0' URI: '1.59' parent: '0' perl: '5.008001' resources: bugtracker: https://github.com/plack/Plack/issues homepage: https://github.com/plack/Plack repository: https://github.com/plack/Plack.git version: '1.0039' x_authority: cpan:MIYAGAWA x_contributors: - 'Aaron Trevena ' - 'Ævar Arnfjörð Bjarmason ' - 'Alexandr Ciornii ' - 'Alex J. G. BurzyÅ„ski ' - 'Allan Whiteford ' - 'Andrew Rodland ' - 'Andy Wardley ' - 'Aristotle Pagaltzis ' - "Arthur Axel 'fREW' Schmidt " - 'Ashley Pond V ' - 'Ask Bjørn Hansen ' - 'Ben Morrow ' - 'Bernhard Graf ' - 'Chad Granum ' - 'chansen ' - 'Chia-liang Kao ' - 'cho45 ' - 'Christian Walde ' - 'chromatic ' - 'Cosimo Streppone ' - 'Daisuke Maki ' - 'Daisuke Murase ' - 'Dave Marr ' - 'Dave Rolsky ' - 'David E. Wheeler ' - 'David Steinbrunner ' - 'Eduardo Arino de la Rubia ' - 'Eric Johnson ' - 'Eugen Konkov ' - 'Fabrice Gabolde ' - 'fayland ' - 'Flavio Poletti ' - 'Florian Ragwitz ' - 'franck cuny ' - 'Graham Knop ' - 'Grant McLean ' - 'Hans Dieter Pearcey ' - 'Haruka Iwao ' - 'Henry Baragar ' - 'hiratara ' - 'HIROSE Masaaki ' - 'Hiroshi Sakai ' - 'Ian Bradley ' - 'Ian Burrell ' - 'Jakob Voss ' - 'Jakob Voss ' - 'Jay Hannah ' - 'Jesse Luehrs ' - 'Jiro Nishiguchi ' - 'Johannes Plunien ' - 'John Beppu ' - 'John Napiorkowski ' - 'Jonathan Swartz ' - 'JoseÌ Pinheiro Neta ' - 'Justin Davis ' - 'kakuno ' - 'Kang-min Liu ' - 'Karen Etheridge ' - 'Kazuho Oku ' - 'Keedi Kim ' - 'Lee Aylward ' - 'Leo Lapworth ' - 'mala ' - 'Marian Schubert ' - 'Mark Fowler ' - 'Mark Stosberg ' - 'Masahiro Chiba ' - 'Masahiro Nagano ' - 'Michael G. Schwern ' - 'mickey ' - 'Nick Wellnhofer ' - 'Nobuo Danjou ' - 'Olaf Alders ' - 'Oliver Gorwits ' - 'Oliver Paukstadt ' - 'Oliver Trosien ' - 'Olivier Mengué ' - 'osfameron ' - 'Panu Ervamaa ' - 'Paul Driver ' - 'Pedro Melo ' - 'Peter Flanigan ' - 'Peter Makholm ' - 'Piotr Roszatycki ' - 'punytan ' - 'Rafael Kitover ' - 'Randy Stauner ' - 'Ray Miller ' - 'Ricky Morse ' - 'Rob Hoelz ' - 'Ryo Miyake ' - 'Sawyer X ' - 'Scott S. McCoy ' - 'Shawn M Moore ' - 'Stephen Clouse ' - 'Stevan Little ' - 'Stuart A Johnston ' - 'Takeshi OKURA ' - 'Tatsuhiko Miyagawa ' - 'Tim Bunce ' - 'Tokuhiro Matsuno ' - 'Tomas Doran ' - 'Tom Heady ' - 'vti ' - 'Wallace Reis ' - 'xaicron ' - 'Yann Kerherve ' - 'yappo ' - 'Yury Zavarin ' - 'Yuval Kogman ' - 'å”é³³ ' Plack-1.0039/README000644 000765 000024 00000014307 12631015706 014470 0ustar00miyagawastaff000000 000000 NAME Plack - Perl Superglue for Web frameworks and Web Servers (PSGI toolkit) DESCRIPTION Plack is a set of tools for using the PSGI stack. It contains middleware components, a reference server and utilities for Web application frameworks. Plack is like Ruby's Rack or Python's Paste for WSGI. See PSGI for the PSGI specification and PSGI::FAQ to know what PSGI and Plack are and why we need them. MODULES AND UTILITIES Plack::Handler Plack::Handler and its subclasses contains adapters for web servers. We have adapters for the built-in standalone web server HTTP::Server::PSGI, CGI, FCGI, Apache1, Apache2 and HTTP::Server::Simple included in the core Plack distribution. There are also many HTTP server implementations on CPAN that have Plack handlers. See Plack::Handler when writing your own adapters. Plack::Loader Plack::Loader is a loader to load one Plack::Handler adapter and run a PSGI application code reference with it. Plack::Util Plack::Util contains a lot of utility functions for server implementors as well as middleware authors. .psgi files A PSGI application is a code reference but it's not easy to pass code reference via the command line or configuration files, so Plack uses a convention that you need a file named app.psgi or similar, which would be loaded (via perl's core function do) to return the PSGI application code reference. # Hello.psgi my $app = sub { my $env = shift; # ... return [ $status, $headers, $body ]; }; If you use a web framework, chances are that they provide a helper utility to automatically generate these .psgi files for you, such as: # MyApp.psgi use MyApp; my $app = sub { MyApp->run_psgi(@_) }; It's important that the return value of .psgi file is the code reference. See eg/dot-psgi directory for more examples of .psgi files. plackup, Plack::Runner plackup is a command line launcher to run PSGI applications from command line using Plack::Loader to load PSGI backends. It can be used to run standalone servers and FastCGI daemon processes. Other server backends like Apache2 needs a separate configuration but .psgi application file can still be the same. If you want to write your own frontend that replaces, or adds functionalities to plackup, take a look at the Plack::Runner module. Plack::Middleware PSGI middleware is a PSGI application that wraps an existing PSGI application and plays both side of application and servers. From the servers the wrapped code reference still looks like and behaves exactly the same as PSGI applications. Plack::Middleware gives you an easy way to wrap PSGI applications with a clean API, and compatibility with Plack::Builder DSL. Plack::Builder Plack::Builder gives you a DSL that you can enable Middleware in .psgi files to wrap existent PSGI applications. Plack::Request, Plack::Response Plack::Request gives you a nice wrapper API around PSGI $env hash to get headers, cookies and query parameters much like Apache::Request in mod_perl. Plack::Response does the same to construct the response array reference. Plack::Test Plack::Test is a unified interface to test your PSGI application using standard HTTP::Request and HTTP::Response pair with simple callbacks. Plack::Test::Suite Plack::Test::Suite is a test suite to test a new PSGI server backend. CONTRIBUTING Patches and Bug Fixes Small patches and bug fixes can be either submitted via nopaste on IRC irc://irc.perl.org/#plack or the github issue tracker . Forking on github is another good way if you intend to make larger fixes. See also http://contributing.appspot.com/plack when you think this document is terribly outdated. Module Namespaces Modules added to the Plack:: sub-namespaces should be reasonably generic components which are useful as building blocks and not just simply using Plack. Middleware authors are free to use the Plack::Middleware:: namespace for their middleware components. Middleware must be written in the pipeline style such that they can chained together with other middleware components. The Plack::Middleware:: modules in the core distribution are good examples of such modules. It is recommended that you inherit from Plack::Middleware for these types of modules. Not all middleware components are wrappers, but instead are more like endpoints in a middleware chain. These types of components should use the Plack::App:: namespace. Again, look in the core modules to see excellent examples of these (Plack::App::File, Plack::App::Directory, etc.). It is recommended that you inherit from Plack::Component for these types of modules. DO NOT USE Plack:: namespace to build a new web application or a framework. It's like naming your application under CGI:: namespace if it's supposed to run on CGI and that is a really bad choice and would confuse people badly. AUTHOR Tatsuhiko Miyagawa COPYRIGHT The following copyright notice applies to all the files provided in this distribution, including binary files, unless explicitly noted otherwise. Copyright 2009-2013 Tatsuhiko Miyagawa CORE DEVELOPERS Tatsuhiko Miyagawa (miyagawa) Tokuhiro Matsuno (tokuhirom) Jesse Luehrs (doy) Tomas Doran (bobtfish) Graham Knop (haarg) CONTRIBUTORS Yuval Kogman (nothingmuch) Kazuhiro Osawa (Yappo) Kazuho Oku Florian Ragwitz (rafl) Chia-liang Kao (clkao) Masahiro Honma (hiratara) Daisuke Murase (typester) John Beppu Matt S Trout (mst) Shawn M Moore (Sartak) Stevan Little Hans Dieter Pearcey (confound) mala Mark Stosberg Aaron Trevena SEE ALSO The PSGI specification upon which Plack is based. http://plackperl.org/ The Plack wiki: https://github.com/plack/Plack/wiki The Plack FAQ: https://github.com/plack/Plack/wiki/Faq LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Plack-1.0039/script/000755 000765 000024 00000000000 12631015706 015107 5ustar00miyagawastaff000000 000000 Plack-1.0039/share/000755 000765 000024 00000000000 12631015706 014705 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/000755 000765 000024 00000000000 12631015706 014046 5ustar00miyagawastaff000000 000000 Plack-1.0039/xt/000755 000765 000024 00000000000 12631015706 014236 5ustar00miyagawastaff000000 000000 Plack-1.0039/xt/author-downstream.t000644 000765 000024 00000000751 12631015706 020111 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More 0.98; use File::Temp qw(tempdir); plan skip_all => "AUTHOR_TESTING is required." unless $ENV{AUTHOR_TESTING}; my @downstream = qw( Starman Starlet Twiggy Monoceros Feersum Corona Amon2 Tatsumaki OX Dancer2 Catalyst Web::Machine Web::Request ); for my $module (@downstream) { my $tmp = tempdir(CLEANUP => 1); is(system("cpanm --notest -l $tmp ."), 0); is(system("cpanm -l $tmp --test-only $module"), 0, $module); } done_testing; Plack-1.0039/t/author-pod-syntax.t000644 000765 000024 00000000503 12631015706 017637 0ustar00miyagawastaff000000 000000 #!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Plack-1.0039/t/FCGIUtils.pm000644 000765 000024 00000004730 12631015706 016141 0ustar00miyagawastaff000000 000000 package t::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 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) = @_; my $script_name = $ENV{PLACK_TEST_SCRIPT_NAME} || '/'; <<"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 = ( "$script_name" => (( "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; Plack-1.0039/t/HTTP-Message-PSGI/000755 000765 000024 00000000000 12631015706 016747 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/HTTP-Server-PSGI/000755 000765 000024 00000000000 12631015706 016631 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Builder/000755 000765 000024 00000000000 12631015706 016464 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Handler/000755 000765 000024 00000000000 12631015706 016453 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-HTTPParser-PP/000755 000765 000024 00000000000 12631015706 017347 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Loader/000755 000765 000024 00000000000 12631015706 016304 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Middleware/000755 000765 000024 00000000000 12631015706 017153 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-MIME/000755 000765 000024 00000000000 12631015706 015625 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Request/000755 000765 000024 00000000000 12631015706 016526 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Response/000755 000765 000024 00000000000 12631015706 016674 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Runner/000755 000765 000024 00000000000 12631015706 016347 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-TempBuffer/000755 000765 000024 00000000000 12631015706 017135 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Test/000755 000765 000024 00000000000 12631015706 016015 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Util/000755 000765 000024 00000000000 12631015706 016013 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/test.txt000644 000765 000024 00000000004 12631015706 015560 0ustar00miyagawastaff000000 000000 foo Plack-1.0039/t/Plack-Util/bad.psgi000644 000765 000024 00000000112 12631015706 017417 0ustar00miyagawastaff000000 000000 use strict; eval { load_class("CGI") }; sub { [ 200, [], ["Hello"] ] }; Plack-1.0039/t/Plack-Util/bad2.psgi000644 000765 000024 00000000100 12631015706 017476 0ustar00miyagawastaff000000 000000 sub load_class { die "woohaa" } sub { [ 200, [], ["Hello"] ] }; Plack-1.0039/t/Plack-Util/bin/000755 000765 000024 00000000000 12631015706 016563 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Util/can.t000644 000765 000024 00000000755 12631015706 016750 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Util; my $can; my $lives = eval { $can = Plack::Util->can('something_obviously_fake'); 1 }; ok($lives, "Did not die calling 'can' on Plack::Util package with invalid sub"); is($can, undef, "Cannot do that method"); $lives = eval { $can = Plack::Util->can('content_length'); 1 }; ok($lives, "Did not die calling 'can' on Plack::Util package with real sub"); is($can, \&Plack::Util::content_length, "can() returns the sub"); done_testing; Plack-1.0039/t/Plack-Util/error.psgi000644 000765 000024 00000000050 12631015706 020023 0ustar00miyagawastaff000000 000000 use strict; sub { $env = shift; }; Plack-1.0039/t/Plack-Util/foreach.t000644 000765 000024 00000001454 12631015706 017613 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Util; { package Foo; sub new { bless {}, shift } } do { for my $body ('error', \'error', qr//, +{}, sub {}, Foo->new()) { eval { Plack::Util::foreach($body, sub {}); }; like $@, qr/Can't (call|locate object) method "getline"/; } }; do { my @x = (0, 1); Plack::Util::foreach([0, 1], sub { my $line = shift; is($line, $x[$line]) }); }; { package Bar; sub new { bless { i => 0 }, shift } my @x = (2, 3); sub getline { my $self = shift; $x[$self->{i}++]; } sub current { $x[shift->{i}-1] } sub close { ::ok(1, 'close') } } do { my $bar = Bar->new; Plack::Util::foreach($bar, sub { my $line = shift; is($line, $bar->current) }); }; done_testing; Plack-1.0039/t/Plack-Util/header_exists.t000644 000765 000024 00000001736 12631015706 021036 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Util; { my $headers = []; ok !Plack::Util::header_exists($headers, 'Foo'), 'no headers'; } { my $headers = [ Baz => 'bar', Bar => 'baz' ]; ok !Plack::Util::header_exists($headers, 'Foo'), 'header does not exist'; } { my $headers = [ Foo => 'bar', Bar => 'baz' ]; ok Plack::Util::header_exists($headers, 'Foo'), 'header is first'; } { my $headers = [ Bar => 'foo', Foo => 'baz' ]; ok Plack::Util::header_exists($headers, 'Foo'), 'header is last'; } { my $headers = [ Bar => 'foo', Foo => 'baz', Baz => 'quux' ]; ok Plack::Util::header_exists($headers, 'Foo'), 'header in middle'; } { my $headers = [ Bar => 'foo', Foo => 'baz', Baz => 'foo', Foo => 'quux', Quux => 'bar' ]; ok Plack::Util::header_exists($headers, 'Foo'), 'header occurs multiple times'; } { my $headers = [ Foo => 'bar', Bar => 'baz' ]; ok Plack::Util::header_exists($headers, 'foo'), 'case-insensitive'; } done_testing; Plack-1.0039/t/Plack-Util/header_get.t000644 000765 000024 00000001217 12631015706 020270 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Util; { my $headers = []; is Plack::Util::header_get($headers, 'Foo'), undef, 'empty headers, scalar'; } { my $headers = []; is_deeply [ Plack::Util::header_get($headers, 'Foo') ], [], 'empty headers, list'; } { my $headers = [ Foo => 'bar' ]; is Plack::Util::header_get($headers, 'Foo'), 'bar', 'header exists, scalar'; } { my $headers = [ Foo => 'bar' ]; is_deeply [ Plack::Util::header_get($headers, 'Foo') ], [ 'bar' ], 'header exists, list'; } { my $headers = [ Foo => 'bar' ]; is Plack::Util::header_get($headers, 'foo'), 'bar', 'case-insensitive' } done_testing; Plack-1.0039/t/Plack-Util/header_push.t000644 000765 000024 00000001141 12631015706 020464 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Util; { my $headers = []; Plack::Util::header_push($headers, Foo => 'quox'); is_deeply $headers, [ Foo => 'quox' ], 'push to empty headers'; } { my $headers = [ Bar => 'baz' ]; Plack::Util::header_push($headers, Foo => 'quox'); is_deeply $headers, [ Bar => 'baz', Foo => 'quox' ], 'push to non-empty headers'; } { my $headers = [ Foo => 'bar', Bar => 'baz' ]; Plack::Util::header_push($headers, Foo => 'quox'); is_deeply $headers, [ Foo => 'bar', Bar => 'baz', Foo => 'quox' ], 'push with previous header values'; } done_testing; Plack-1.0039/t/Plack-Util/header_remove.t000644 000765 000024 00000002375 12631015706 021014 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Util; { my $headers = []; Plack::Util::header_remove($headers, 'Foo'); is_deeply $headers, [], 'empty headers'; } { my $headers = [ Bar => 'baz' ]; Plack::Util::header_remove($headers, 'Foo'); is_deeply $headers, [ Bar => 'baz' ], 'other headers only'; } { my $headers = [ Foo => 'bar', Bar => 'foo' ]; Plack::Util::header_remove($headers, 'Foo'); is_deeply $headers, [ Bar => 'foo' ], 'header is first'; } { my $headers = [ Bar => 'foo', Foo => 'bar' ]; Plack::Util::header_remove($headers, 'Foo'); is_deeply $headers, [ Bar => 'foo' ], 'header is last'; } { my $headers = [ Bar => 'foo', Foo => 'baz', Baz => 'quux' ]; Plack::Util::header_remove($headers, 'Foo'); is_deeply $headers, [ Bar => 'foo', Baz => 'quux' ], 'header in middle'; } { my $headers = [ Bar => 'foo', Foo => 'baz', Baz => 'foo', Foo => 'quux', Quux => 'bar' ]; Plack::Util::header_remove($headers, 'Foo'); is_deeply $headers, [ Bar => 'foo', Baz => 'foo', Quux => 'bar' ], 'header occurs multiple times'; } { my $headers = [ Foo => 'bar', Bar => 'baz' ]; Plack::Util::header_remove($headers, 'foo'); is_deeply $headers, [ Bar => 'baz' ], 'case-insensitive'; } done_testing; Plack-1.0039/t/Plack-Util/header_set.t000644 000765 000024 00000001542 12631015706 020305 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Util; { my $headers = []; Plack::Util::header_set($headers, Bar => 'baz'); is_deeply $headers, [ Bar => 'baz' ], 'empty headers'; } { my $headers = [ Foo => 'bar' ]; Plack::Util::header_set($headers, Bar => 'baz'); is_deeply $headers, [ Foo => 'bar', Bar => 'baz' ], 'other headers only'; } { my $headers = [ Foo => 'bar' ]; Plack::Util::header_set($headers, Foo => 'baz'); is_deeply $headers, [ Foo => 'baz' ], 'one matching header'; } { my $headers = [ Foo => 'bar', Foo => 'baz' ]; Plack::Util::header_set($headers, Foo => 'quox'); is_deeply $headers, [ Foo => 'quox' ], 'several matching headers'; } { my $headers = [ Foo => 'bar' ]; Plack::Util::header_set($headers, foo => 'baz'); is_deeply $headers, [ Foo => 'baz' ], 'case-insensitive'; } done_testing; Plack-1.0039/t/Plack-Util/headers_obj.t000644 000765 000024 00000001061 12631015706 020443 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Util; { my $headers = [ Foo => 'bar' ]; my $h = Plack::Util::headers($headers); $h->set(Bar => 'baz'); is_deeply $headers, [ Foo => 'bar', Bar => 'baz' ]; is_deeply $h->headers, [ Foo => 'bar', Bar => 'baz' ]; is $h->get('Foo'), 'bar'; $h->push('Foo' => 'xxx'); is $h->get('Foo'), 'bar'; my @v = $h->get('Foo'); is_deeply \@v, [ 'bar', 'xxx' ]; ok $h->exists('Bar'); $h->remove('Bar'); ok ! $h->exists('Bar'); is_deeply $headers, $h->headers; } done_testing; Plack-1.0039/t/Plack-Util/Hello.pm000644 000765 000024 00000000220 12631015706 017406 0ustar00miyagawastaff000000 000000 package Hello; sub to_app { return sub { return [200, ['Content-Type', 'text/plain'], ['Hello']]; }; } __PACKAGE__->to_app; Plack-1.0039/t/Plack-Util/hello.psgi000644 000765 000024 00000000101 12631015706 017772 0ustar00miyagawastaff000000 000000 sub { return [200, ['Content-Type', 'text/plain'], ['Hello']] }; Plack-1.0039/t/Plack-Util/inc/000755 000765 000024 00000000000 12631015706 016564 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Util/inline_object.t000644 000765 000024 00000001012 12631015706 020776 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Util; use Try::Tiny; my $counter; my $object = Plack::Util::inline_object( method1 => sub { $counter++ }, ); $object->method1; is $counter, 1, 'method call works'; my $sub = $object->can('method1'); ok $sub, 'can returns true value for method'; try { $sub->($object) }; is $counter, 2, 'can returns sub ref for method'; ok ! try { $object->method2; 1 }, 'croaks if nonexistant method called'; is $object->can('method2'), undef, 'can returns undef for nonexistant method'; done_testing; Plack-1.0039/t/Plack-Util/io_with_path.t000644 000765 000024 00000000360 12631015706 020655 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Util; open my $fh, "<", "t/test.txt"; Plack::Util::set_io_path($fh, "/path/to/test.txt"); is $fh->path, "/path/to/test.txt"; like scalar <$fh>, qr/foo/; ok fileno $fh; isa_ok $fh, 'IO::Handle'; done_testing; Plack-1.0039/t/Plack-Util/is_real_fh.t000644 000765 000024 00000000722 12631015706 020274 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Util; { open my $fh, __FILE__; ok Plack::Util::is_real_fh($fh); } { my $fh = IO::File->new(__FILE__); ok Plack::Util::is_real_fh($fh); } { open my $fh, "<", "/dev/null"; ok ! Plack::Util::is_real_fh($fh); } { open my $fh, "<", \"foo"; ok ! Plack::Util::is_real_fh($fh); } { use IO::File; my $fh = IO::File->new("/dev/null"); ok ! Plack::Util::is_real_fh($fh); } done_testing; Plack-1.0039/t/Plack-Util/load.t000644 000765 000024 00000002475 12631015706 017127 0ustar00miyagawastaff000000 000000 use strict; use Plack::Util; use Plack::Test; use HTTP::Request::Common; use Test::More; { my $app = Plack::Util::load_psgi("t/Plack-Util/hello.psgi"); ok $app; test_psgi $app, sub { is $_[0]->(GET "/")->content, "Hello"; }; } { my $app = Plack::Util::load_psgi("t/Plack-Util/bad.psgi"); ok $app; ok !$INC{"CGI.pm"}; } { my $app = Plack::Util::load_psgi("t/Plack-Util/bad2.psgi"); ok $app; eval { Plack::Util::load_class("Plack") }; is $@, ''; } { use lib "t/Plack-Util"; my $app = Plack::Util::load_psgi("Hello"); ok $app; test_psgi $app, sub { is $_[0]->(GET "/")->content, "Hello"; }; } { eval { Plack::Util::load_psgi("t/Plack-Util/error.psgi") }; like $@, qr/Global symbol/; } { eval { Plack::Util::load_psgi("t/Plack-Util/nonexistent.psgi") }; unlike $@, qr/Died/; } { my $app = Plack::Util::load_psgi("t/Plack-Util/bin/findbin.psgi"); test_psgi $app, sub { like $_[0]->(GET "/")->content, qr!t[/\\]Plack-Util[/\\]bin$!; } } { require Cwd; my $cwd = Cwd::cwd(); chdir "t/Plack-Util"; local @INC = ("./inc", @INC); my $app = Plack::Util::load_psgi("hello.psgi"); ok $app; test_psgi $app, sub { is $_[0]->(GET "/")->content, "Hello"; }; chdir $cwd; } done_testing; Plack-1.0039/t/Plack-Util/response_cb.t000644 000765 000024 00000001351 12631015706 020502 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Plack::Util; use Plack::Test; use Test::More; use HTTP::Request::Common; $Plack::Test::Impl = "Server"; my $app = sub { my $env = shift; return sub { my $respond = shift; my $writer = $respond->([200, [ 'Content-Type' => 'text/plain' ]]); $writer->write('foo'); $writer->write('bar'); $writer->close; }; }; my $mw = sub { my $env = shift; my $res = $app->($env); Plack::Util::response_cb($res, sub { my $res = shift; return sub { my $chunk = shift; return $chunk; } }); }; test_psgi $mw, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->content, 'foobar'; }; done_testing; Plack-1.0039/t/Plack-Util/inc/hello.psgi000644 000765 000024 00000000035 12631015706 020551 0ustar00miyagawastaff000000 000000 die "Do not load this file"; Plack-1.0039/t/Plack-Util/bin/findbin.psgi000644 000765 000024 00000000125 12631015706 021056 0ustar00miyagawastaff000000 000000 use FindBin; sub { [ 200, [ "Content-Type", "text/plain" ], [ "$FindBin::Bin" ] ] }; Plack-1.0039/t/Plack-Test/2args.t000644 000765 000024 00000000472 12631015706 017223 0ustar00miyagawastaff000000 000000 use Plack::Test; use Test::More; use HTTP::Request::Common; $Plack::Test::Impl = "Server"; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my $app = sub { return [ 200, [], [ "Hello" ] ] }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->content, "Hello"; }; done_testing; Plack-1.0039/t/Plack-Test/cookie.t000644 000765 000024 00000001041 12631015706 017447 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use HTTP::Request::Common; use Test::More; use Test::Requires qw(HTTP::Cookies); my $app = sub { return [ 200, [ 'Content-Type' => 'text/html', 'Set-Cookie' => "ID=123; path=/" ], [ "Hi" ] ]; }; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/"); my $cookie_jar = HTTP::Cookies->new; $cookie_jar->extract_cookies($res); my @cookies; $cookie_jar->scan( sub { @cookies = @_ }); ok @cookies; is $cookies[1], 'ID'; }; done_testing; Plack-1.0039/t/Plack-Test/hello.t000644 000765 000024 00000000750 12631015706 017307 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Test; $Plack::Test::Impl = "MockHTTP"; test_psgi client => sub { my $cb = shift; my $req = HTTP::Request->new(GET => "http://localhost/hello"); my $res = $cb->($req); is $res->content, 'Hello World'; is $res->content_type, 'text/plain'; is $res->code, 200; }, app => sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello World" ] ]; }; done_testing; Plack-1.0039/t/Plack-Test/hello_server.t000644 000765 000024 00000001027 12631015706 020673 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Test; $Plack::Test::Impl = "Server"; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; test_psgi client => sub { my $cb = shift; my $req = HTTP::Request->new(GET => "http://localhost/hello"); my $res = $cb->($req); is $res->content, 'Hello World'; is $res->content_type, 'text/plain'; is $res->code, 200; }, app => sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello World" ] ]; }; done_testing; Plack-1.0039/t/Plack-Test/suite.t000644 000765 000024 00000000723 12631015706 017335 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use FindBin; use HTTP::Message::PSGI; use Plack; use Plack::Test::Suite; use Plack::Util; Plack::Test::Suite->runtests(sub { my ($name, $test, $handler) = @_; note $name; my $cb = sub { my $req = shift; my $env = req_to_psgi($req); my $res = res_from_psgi(Plack::Util::run_app $handler, $env); $res->request($req); return $res; }; $test->($cb); }); done_testing; Plack-1.0039/t/Plack-TempBuffer/print.t000644 000765 000024 00000001646 12631015706 020465 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::TempBuffer; my $warn = ''; $SIG{__WARN__} = sub { $warn .= $_[0] }; { my $b = Plack::TempBuffer->new(-1); $b->print("foo"); is $b->size, 3; my $fh = $b->rewind; is do { local $/; <$fh> }, 'foo'; $fh->seek(0, 0); } { local $Plack::TempBuffer::MaxMemoryBufferSize = 12; my $b = Plack::TempBuffer->new; is $b->size, 0; $b->print("foo") for 1..5; is $b->size, 15; my $fh = $b->rewind; isa_ok $fh, 'IO::File'; is do { local $/; <$fh> }, ('foo' x 5); like $warn, qr/MaxMemoryBufferSize.*deprecated/; $warn = ''; } { local $Plack::TempBuffer::MaxMemoryBufferSize = 0; my $b = Plack::TempBuffer->new(3); $b->print("foo\n"); is $b->size, 4; my $fh = $b->rewind; isa_ok $fh, 'IO::File'; is do { local $/; <$fh> }, "foo\n"; like $warn, qr/MaxMemoryBufferSize.*deprecated/; $warn = ''; } done_testing; Plack-1.0039/t/Plack-Runner/options.t000644 000765 000024 00000002712 12631015706 020231 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Runner; sub p { my $r = Plack::Runner->new; $r->parse_options(@_); return {@{$r->{options}}}; } my %defaults = ( host => undef, port => 5000, listen => [ ':5000' ], socket => undef ); is_deeply p(), { %defaults }; is_deeply p('-l', '/tmp/foo.sock'), { host => undef, port => undef, listen => [ '/tmp/foo.sock' ], socket => '/tmp/foo.sock' }; is_deeply p('-o', '0.0.0.0', '--port', 9000), { host => '0.0.0.0', port => 9000, listen => [ '0.0.0.0:9000' ], socket => undef }; is_deeply p('-S', 'foo.sock'), { host => undef, port => undef, listen => [ 'foo.sock' ], socket => 'foo.sock' }; is_deeply p('-l', ':80'), { host => undef, port => 80, listen => [ ':80' ], socket => undef }; is_deeply p('-l', '10.0.0.1:80', '-l', 'unix.sock'), { host => '10.0.0.1', port => 80, listen => [ '10.0.0.1:80', 'unix.sock' ], socket => 'unix.sock' }; is_deeply p('-l', ':80', '--disable-foo', '--enable-bar'), { host => undef, port => 80, listen => [ ':80' ], socket => undef, foo => '', bar => 1 }; { my $r = Plack::Runner->new; $r->parse_options('-D', '--workers=50', '-E', 'development', 'foo.psgi', '--list=4000'); is $r->{env}, 'development'; is $r->{daemonize}, 1; is_deeply $r->{argv}, [ 'foo.psgi' ]; my $options = {@{$r->{options}}}; is $options->{daemonize}, 1; is $options->{workers}, 50; is_deeply $options->{listen}, [ ':5000' ]; is $options->{list}, '4000'; } done_testing; Plack-1.0039/t/Plack-Runner/path.t000644 000765 000024 00000002024 12631015706 017466 0ustar00miyagawastaff000000 000000 use strict; use Cwd; use File::Spec; use File::Temp; use Test::Requires qw(LWP::UserAgent); use Test::More; use Test::TCP qw(empty_port); plan skip_all => "release test only" unless $ENV{RELEASE_TESTING}; sub write_file($$){ my ( $path, $content ) = @_; open my $out, '>', $path or die "$path: $!"; print $out $content; close $out; } my $tmpdir = File::Temp::tempdir( CLEANUP => 1 ); my $psgi_file = File::Spec->catfile($tmpdir, 'app.psgi'); write_file $psgi_file, qq/my \$app = sub {return [200, [], ["hello world"]]}\n/; my $port = empty_port(); my $pid = fork; if ($pid == 0) { close STDERR; exec($^X, '-Ilib', 'script/plackup', '-p', $port, '--path', '/app/', '-a', $psgi_file) or die $@; } else { $SIG{INT} = 'IGNORE'; sleep 1; my $ua = LWP::UserAgent->new; my $res = $ua->get("http://localhost:$port/"); is $res->code, 404; $res = $ua->get("http://localhost:$port/app/"); is $res->code, 200; is $res->content, 'hello world'; kill 'INT', $pid; wait; } done_testing; Plack-1.0039/t/Plack-Response/body.t000644 000765 000024 00000001264 12631015706 020021 0ustar00miyagawastaff000000 000000 use strict; use warnings; use FindBin; use Test::More; use Plack::Response; use URI; use File::Temp; sub r($) { my $res = Plack::Response->new(200); $res->body(@_); return $res->finalize->[2]; } is_deeply r "Hello World", [ "Hello World" ]; is_deeply r [ "Hello", "World" ], [ "Hello", "World" ]; { open my $fh, "$FindBin::Bin/body.t"; is_deeply r $fh, $fh; } { my $foo = "bar"; open my $io, "<", \$foo; is_deeply r $io, $io; } { my $uri = URI->new("foo"); # stringified object is_deeply r $uri, [ $uri ]; } { my $tmp = File::Temp->new; # File::Temp has stringify method, but it is-a IO::Handle. is_deeply r $tmp, $tmp; } done_testing; Plack-1.0039/t/Plack-Response/compatible.t000644 000765 000024 00000002146 12631015706 021203 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Response; { my $res = Plack::Response->new; $res->code(200); $res->header("Foo\000Bar" => "baz"); $res->header("Qux\177Quux" => "42"); $res->body("Hello"); is_deeply $res->finalize, [ 200, [ "Foo\000Bar" => 'baz', "Qux\177Quux" => '42' ], ["Hello"] ]; } { my $res = Plack::Response->new; $res->code(200); $res->header("X-LWS-I" => "Bar\r\n true"); $res->header("X-LWS-II" => "Bar\r\n\t\ttrue"); $res->body("Hello"); is_deeply $res->finalize, [ 200, [ 'X-LWS-I' => 'Bar true', 'X-LWS-II' => 'Bar true' ], ["Hello"] ]; } { my $res = Plack::Response->new; $res->code(200); $res->header("X-CR-LF" => "Foo\nBar\rBaz"); $res->body("Hello"); is_deeply $res->finalize, [ 200, [ 'X-CR-LF' => 'FooBarBaz' ], ["Hello"] ]; } { my $res = Plack::Response->new; $res->code(200); $res->header("X-CR-LF" => "Foo\nBar\rBaz"); $res->body("Hello"); is_deeply $res->finalize, [ 200, [ 'X-CR-LF' => 'FooBarBaz' ], ["Hello"] ]; } done_testing; Plack-1.0039/t/Plack-Response/cookie.t000644 000765 000024 00000001523 12631015706 020333 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::More; use Plack::Response; use HTTP::Request::Common; my $app = sub { my $res = Plack::Response->new(200); $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' }; $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 }; $res->cookies->{t3} = { value => "123123", "max-age" => 15 }; $res->cookies->{t4} = { value => "foo=bar&baz=qux", "max-age" => 15 }; $res->finalize; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); my @v = sort $res->header('Set-Cookie'); is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin"; like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/; is $v[2], "t3=123123; max-age=15"; is $v[3], "t4=foo%3Dbar%26baz%3Dqux; max-age=15"; }; done_testing; Plack-1.0039/t/Plack-Response/new.t000644 000765 000024 00000001226 12631015706 017653 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Response; { my $res = Plack::Response->new(302); is $res->status, 302; is $res->code, 302; } { my $res = Plack::Response->new(200, [ 'Content-Type' => 'text/plain' ]); is $res->content_type, 'text/plain'; } { my $res = Plack::Response->new(200, { 'Content-Type' => 'text/plain' }); is $res->content_type, 'text/plain'; } { my $res = Plack::Response->new(200); $res->content_type('image/png'); is $res->content_type, 'image/png'; } { my $res = Plack::Response->new(200); $res->header('X-Foo' => "bar"); is $res->header('X-Foo'), "bar"; } done_testing; Plack-1.0039/t/Plack-Response/redirect.t000644 000765 000024 00000001347 12631015706 020667 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Response; { my $res = Plack::Response->new; $res->redirect('http://www.google.com/'); is $res->location, 'http://www.google.com/'; is $res->code, 302; is_deeply $res->finalize, [ 302, [ 'Location' => 'http://www.google.com/' ], [] ]; } { my $res = Plack::Response->new; $res->redirect('http://www.google.com/', 301); is_deeply $res->finalize, [ 301, [ 'Location' => 'http://www.google.com/' ], [] ]; } { my $uri_invalid = "http://www.google.com/\r\nX-Injection: true\r\n\r\nHello World"; my $res = Plack::Response->new; $res->redirect($uri_invalid, 301); my $psgi_res = $res->finalize; ok $psgi_res->[1][1] !~ /\n/; } done_testing; Plack-1.0039/t/Plack-Response/response.t000644 000765 000024 00000002313 12631015706 020716 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Response; sub res { my $res = Plack::Response->new; my %v = @_; while (my($k, $v) = each %v) { $res->$k($v); } $res->finalize; } is_deeply( res( status => 200, body => 'hello', ), [ 200, +[], [ 'hello' ] ] ); my $res = res( status => 200, cookies => +{ 'foo_sid' => +{ value => 'ASDFJKL:', expires => 'Thu, 25-Apr-1999 00:40:33 GMT', domain => 'example.com', path => '/', }, 'poo_sid' => +{ value => 'QWERTYUI', expires => 'Thu, 25-Apr-1999 00:40:33 GMT', domain => 'example.com', path => '/', }, }, body => 'hello', ); is($res->[0], 200); is(scalar(@{ $res->[1] }), 4); is($res->[1][0], 'Set-Cookie'); is($res->[1][2], 'Set-Cookie'); my @cookies = sort($res->[1][1], $res->[1][3]); is($cookies[0], 'foo_sid=ASDFJKL%3A; domain=example.com; path=/; expires=Thu, 25-Apr-1999 00:40:33 GMT'); is($cookies[1], 'poo_sid=QWERTYUI; domain=example.com; path=/; expires=Thu, 25-Apr-1999 00:40:33 GMT'); is(scalar(@{ $res->[2] }), 1); is($res->[2][0], 'hello'); done_testing; Plack-1.0039/t/Plack-Response/to_app.t000644 000765 000024 00000000535 12631015706 020346 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common; use Plack::Test; use Plack::Response; my $res = Plack::Response->new(200); $res->body("hello"); test_psgi $res->to_app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200, 'response code'; is $res->content, 'hello', 'content'; }; done_testing; Plack-1.0039/t/Plack-Request/base.t000644 000765 000024 00000002535 12631015706 017632 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Plack::Request; use Test::More; my @tests = ( { host => 'localhost', base => 'http://localhost/' }, { script_name => '/foo', host => 'localhost', base => 'http://localhost/foo' }, { script_name => '/foo bar', host => 'localhost', base => 'http://localhost/foo%20bar' }, { scheme => 'http', host => 'localhost:91', base => 'http://localhost:91/' }, { scheme => 'http', host => 'example.com', base => 'http://example.com/' }, { scheme => 'https', host => 'example.com', base => 'https://example.com/' }, { scheme => 'http', server_name => 'example.com', server_port => 80, base => 'http://example.com/' }, { scheme => 'http', server_name => 'example.com', server_port => 8080, base => 'http://example.com:8080/' }, { host => 'foobar.com', server_name => 'example.com', server_port => 8080, base => 'http://foobar.com/' }, ); plan tests => 1*@tests; for my $block (@tests) { my $env = { 'psgi.url_scheme' => $block->{scheme} || 'http', HTTP_HOST => $block->{host} || undef, SERVER_NAME => $block->{server_name} || undef, SERVER_PORT => $block->{server_port} || undef, SCRIPT_NAME => $block->{script_name} || '', }; my $req = Plack::Request->new($env); is $req->base, $block->{base}; } Plack-1.0039/t/Plack-Request/body.t000644 000765 000024 00000000656 12631015706 017657 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Test; use Plack::Request; use HTTP::Request::Common; my $app = sub { my $req = Plack::Request->new(shift); is_deeply $req->body_parameters, { foo => 'bar' }; is $req->content, 'foo=bar'; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(POST "/", { foo => "bar" }); ok $res->is_success; }; done_testing; Plack-1.0039/t/Plack-Request/content-on-get.t000644 000765 000024 00000000677 12631015706 021566 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Test; use Plack::Request; use HTTP::Request::Common; my $app = sub { my $req = Plack::Request->new(shift); is $req->content, ''; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); ok $res->is_success or diag $res->content; $res = $cb->(HEAD "/"); ok $res->is_success or diag $res->content; }; done_testing; Plack-1.0039/t/Plack-Request/content.t000644 000765 000024 00000001225 12631015706 020365 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Test; use Plack::Request; my $app = sub { my $env = shift; my $req = Plack::Request->new($env); is $req->content, 'body'; # emulate other PSGI apps that reads from input, but not reset $env->{'psgi.input'}->read(my($dummy), $env->{CONTENT_LENGTH}, 0); $req = Plack::Request->new($env); is $req->content, 'body'; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; my $req = HTTP::Request->new(POST => "/"); $req->content("body"); $req->content_type('text/plain'); $req->content_length(4); $cb->($req); }; done_testing; Plack-1.0039/t/Plack-Request/cookie.t000644 000765 000024 00000002422 12631015706 020164 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request; use Plack::Test; use Plack::Request; my $app = sub { my $req = Plack::Request->new(shift); is $req->cookies->{undef}, undef, "non-existing keys return undef"; is $req->cookies->{Foo}, 'Bar'; is $req->cookies->{Bar}, 'Baz'; is $req->cookies->{XXX}, 'Foo Bar'; is $req->cookies->{YYY}, 0, "When we get multiple values we return the first one (which e.g. Apache does too)"; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; my $req = HTTP::Request->new(GET => "/"); $req->header(Cookie => 'Foo=Bar; Bar=Baz; XXX=Foo%20Bar; YYY=0; YYY=3'); $cb->($req); }; $app = sub { my $req = Plack::Request->new(shift); is_deeply $req->cookies, {}; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; $cb->(HTTP::Request->new(GET => "/")); }; $app = sub { my $warn = 0; local $SIG{__WARN__} = sub { $warn++ }; my $req = Plack::Request->new(shift); is $req->cookies->{Foo}, 'Bar'; is $warn, 0; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; my $req = HTTP::Request->new(GET => "/"); $req->header(Cookie => 'Foo=Bar,; Bar=Baz;'); $cb->($req); }; done_testing; Plack-1.0039/t/Plack-Request/double_port.t000644 000765 000024 00000000651 12631015706 021233 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Test; use Plack::Request; use HTTP::Request::Common; $Plack::Test::Impl = 'Server'; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my $app = sub { my $req = Plack::Request->new(shift); return [200, [], [ $req->uri ]]; }; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/foo"); ok $res->content !~ /:\d+:\d+/; }; done_testing; Plack-1.0039/t/Plack-Request/foo1.txt000644 000765 000024 00000000004 12631015706 020125 0ustar00miyagawastaff000000 000000 foo Plack-1.0039/t/Plack-Request/foo2.txt000644 000765 000024 00000000004 12631015706 020126 0ustar00miyagawastaff000000 000000 foo Plack-1.0039/t/Plack-Request/hostname.t000644 000765 000024 00000000500 12631015706 020524 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Test; use Plack::Request; plan tests => 2; my $req = Plack::Request->new({ REMOTE_HOST => "foo.example.com" }); is $req->remote_host, "foo.example.com"; $req = Plack::Request->new({ REMOTE_HOST => '', REMOTE_ADDR => '127.0.0.1' }); is $req->address, "127.0.0.1"; Plack-1.0039/t/Plack-Request/many_upload.t000644 000765 000024 00000003544 12631015706 021231 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Request; my $content = qq{------BOUNDARY Content-Disposition: form-data; name="test_upload_file"; filename="yappo.txt" Content-Type: text/plain SHOGUN ------BOUNDARY Content-Disposition: form-data; name="test_upload_file"; filename="yappo2.txt" Content-Type: text/plain SHOGUN2 ------BOUNDARY Content-Disposition: form-data; name="test_upload_file3"; filename="yappo3.txt" Content-Type: text/plain SHOGUN3 ------BOUNDARY Content-Disposition: form-data; name="test_upload_file4"; filename="yappo4.txt" Content-Type: text/plain SHOGUN4 ------BOUNDARY Content-Disposition: form-data; name="test_upload_file4"; filename="yappo5.txt" Content-Type: text/plain SHOGUN4 ------BOUNDARY Content-Disposition: form-data; name="test_upload_file6"; filename="yappo6.txt" Content-Type: text/plain SHOGUN6 ------BOUNDARY-- }; $content =~ s/\r\n/\n/g; $content =~ s/\n/\r\n/g; { open my $in, '<', \$content; my $req = Plack::Request->new({ 'psgi.input' => $in, CONTENT_LENGTH => length($content), CONTENT_TYPE => 'multipart/form-data; boundary=----BOUNDARY', REQUEST_METHOD => 'POST', SCRIPT_NAME => '/', SERVER_PORT => 80, }); my @undef = $req->upload('undef'); is @undef, 0; my $undef = $req->upload('undef'); is $undef, undef; my @uploads = $req->upload('test_upload_file'); like slurp($uploads[0]), qr|^SHOGUN|; like slurp($uploads[1]), qr|^SHOGUN|; is slurp($req->upload('test_upload_file4')), 'SHOGUN4'; my $test_upload_file3 = $req->upload('test_upload_file3'); is slurp($test_upload_file3), 'SHOGUN3'; my @test_upload_file6 = $req->upload('test_upload_file6'); is slurp($test_upload_file6[0]), 'SHOGUN6'; } done_testing; sub slurp { my $up = shift; open my $fh, "<", $up->path or die; join '', <$fh>; } Plack-1.0039/t/Plack-Request/multi_read.t000644 000765 000024 00000000764 12631015706 021047 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Test; use Plack::Request; use HTTP::Request::Common; my $app = sub { my $env = shift; my $req = Plack::Request->new($env); is $req->content, 'foo=bar'; is $req->content, 'foo=bar'; $req = Plack::Request->new($env); is $req->content, 'foo=bar'; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(POST "/", { foo => "bar" }); ok $res->is_success; }; done_testing; Plack-1.0039/t/Plack-Request/new.t000644 000765 000024 00000001313 12631015706 017502 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Request; my $req = Plack::Request->new({ REQUEST_METHOD => 'GET', SERVER_PROTOCOL => 'HTTP/1.1', SERVER_PORT => 80, SERVER_NAME => 'example.com', SCRIPT_NAME => '/foo', REMOTE_ADDR => '127.0.0.1', 'psgi.version' => [ 1, 0 ], 'psgi.input' => undef, 'psgi.errors' => undef, 'psgi.url_scheme' => 'http', }); isa_ok($req, 'Plack::Request'); is($req->address, '127.0.0.1', 'address'); is($req->method, 'GET', 'method'); is($req->protocol, 'HTTP/1.1', 'protocol'); is($req->uri, 'http://example.com/foo', 'uri'); is($req->port, 80, 'port'); is($req->scheme, 'http', 'url_scheme'); done_testing(); Plack-1.0039/t/Plack-Request/parameters.t000644 000765 000024 00000000770 12631015706 021062 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Request; use Plack::Test; use HTTP::Request::Common; my $app = sub { my $req = Plack::Request->new(shift); my $b = $req->body_parameters; is $b->{foo}, 'bar'; my $q = $req->query_parameters; is $q->{bar}, 'baz'; is_deeply $req->parameters, { foo => 'bar', 'bar' => 'baz' }; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; $cb->(POST "/?bar=baz", { foo => "bar" }); }; done_testing; Plack-1.0039/t/Plack-Request/params.t000644 000765 000024 00000001674 12631015706 020206 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Request; my $req = Plack::Request->new({ QUERY_STRING => "foo=bar" }); is_deeply $req->parameters, { foo => "bar" }; is $req->param('foo'), "bar"; is_deeply [ $req->param ], [ 'foo' ]; $req = Plack::Request->new({ QUERY_STRING => "foo=bar&foo=baz" }); is_deeply $req->parameters, { foo => "baz" }; is $req->param('foo'), "baz"; is_deeply [ $req->param('foo') ] , [ qw(bar baz) ]; is_deeply [ $req->param ], [ 'foo' ]; $req = Plack::Request->new({ QUERY_STRING => "foo=bar&foo=baz&bar=baz" }); is_deeply $req->parameters, { foo => "baz", bar => "baz" }; is_deeply $req->query_parameters, { foo => "baz", bar => "baz" }; is $req->param('foo'), "baz"; is_deeply [ $req->param('foo') ] , [ qw(bar baz) ]; is_deeply [ sort $req->param ], [ 'bar', 'foo' ]; $req = Plack::Request->new({ QUERY_STRING => "&&foo=bar&&baz=quux" }); is_deeply $req->parameters, { foo => 'bar', baz => 'quux' }; done_testing; Plack-1.0039/t/Plack-Request/path_info.t000644 000765 000024 00000001375 12631015706 020670 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use Plack::App::URLMap; use Plack::Test; use Plack::Request; use HTTP::Request::Common; my $path_app = sub { my $req = Plack::Request->new(shift); my $res = $req->new_response(200); $res->content_type('text/plain'); $res->content($req->path_info); return $res->finalize; }; my $app = Plack::App::URLMap->new; $app->map("/foo" => $path_app); $app->map("/" => $path_app); test_psgi app => $app->to_app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/foo"); is $res->content, ''; $res = $cb->(GET "http://localhost/foo/bar"); is $res->content, '/bar'; $res = $cb->(GET "http://localhost/xxx/yyy"); is $res->content, '/xxx/yyy'; }; done_testing; Plack-1.0039/t/Plack-Request/path_info_escaped.t000644 000765 000024 00000001631 12631015706 022347 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use Plack::Request; use HTTP::Request::Common; use Data::Dumper; my $path_app = sub { my $req = Plack::Request->new(shift); my $res = $req->new_response(200); $res->content_type('text/plain'); $res->content('my ' . Dumper([ $req->uri, $req->parameters ])); return $res->finalize; }; test_psgi $path_app, sub { my $cb = shift; my $res = $cb->(GET "http://localhost/foo.bar-baz?a=b"); is_deeply eval($res->content), [ URI->new("http://localhost/foo.bar-baz?a=b"), { a => 'b' } ]; $res = $cb->(GET "http://localhost/foo%2fbar#ab"); is_deeply eval($res->content), [ URI->new("http://localhost/foo/bar"), {} ], "%2f vs / can't be distinguished - that's alright"; $res = $cb->(GET "http://localhost/%23foo?a=b"); is_deeply eval($res->content), [ URI->new("http://localhost/%23foo?a=b"), { a => 'b' } ]; }; done_testing; Plack-1.0039/t/Plack-Request/query_string.t000644 000765 000024 00000000664 12631015706 021454 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Request; use Plack::Test; use HTTP::Request::Common; my $app = sub { my $req = Plack::Request->new(shift); return [ 200, [], [ $req->query_string ] ]; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "http://localhost/?foo=bar"); is $res->content, 'foo=bar'; $res = $cb->(GET "http://localhost/?foo+bar"); is $res->content, 'foo+bar'; }; done_testing; Plack-1.0039/t/Plack-Request/readbody.t000644 000765 000024 00000000706 12631015706 020507 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More tests => 1; use Plack::Test; use Plack::Request; use Try::Tiny; { try { my $data = 'a'; open my $input, "<", \$data; my $req = Plack::Request->new({ 'psgi.input' => $input, CONTENT_LENGTH => 3, CONTENT_TYPE => 'application/octet-stream' }); $req->body_parameters; } catch { like $_, qr/Bad Content-Length/; } } Plack-1.0039/t/Plack-Request/request_uri.t000644 000765 000024 00000000704 12631015706 021263 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Request; use Plack::Test; use HTTP::Request::Common; my $app = sub { my $req = Plack::Request->new(shift); return [ 200, [], [ $req->request_uri ] ]; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "http://localhost/foo%20bar"); is $res->content, '/foo%20bar'; $res = $cb->(GET "http://localhost:2020/FOO/bar,baz"); is $res->content, '/FOO/bar,baz'; }; done_testing; Plack-1.0039/t/Plack-Request/upload-basename.t000644 000765 000024 00000000312 12631015706 021744 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More tests => 1; use Plack::Request::Upload; my $upload = Plack::Request::Upload->new( filename => '/tmp/foo/bar/hoge.txt', ); is $upload->basename, 'hoge.txt'; Plack-1.0039/t/Plack-Request/upload-large.t000644 000765 000024 00000001346 12631015706 021273 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Request; use Plack::Test; use HTTP::Request::Common; my $file = "share/baybridge.jpg"; my @backends = qw( Server MockHTTP ); sub flip_backend { $Plack::Test::Impl = shift @backends } local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my $app = sub { my $req = Plack::Request->new(shift); is $req->uploads->{image}->size, -s $file; is $req->uploads->{image}->content_type, 'image/jpeg'; is $req->uploads->{image}->basename, 'baybridge.jpg'; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; $cb->(POST "/", Content_Type => 'form-data', Content => [ image => [ $file ], ]); } while flip_backend; done_testing; Plack-1.0039/t/Plack-Request/upload.t000644 000765 000024 00000002707 12631015706 020205 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Request; use Plack::Test; use HTTP::Request::Common; my @temp_files = (); my $app = sub { my $env = shift; my $req = Plack::Request->new($env); isa_ok $req->uploads->{foo}, 'HASH'; is $req->uploads->{foo}->{filename}, 'foo2.txt'; my @files = $req->upload('foo'); is scalar(@files), 2; is $files[0]->filename, 'foo1.txt'; is $files[1]->filename, 'foo2.txt'; ok -e $files[0]->tempname; is join(', ', sort { $a cmp $b } $req->upload()), 'bar, foo'; for (qw(foo bar)) { my $temp_file = $req->upload($_)->path; ok -f $temp_file; push @temp_files, $temp_file; } is $req->parameters->{baz}, "quux"; my $res = $req->new_response(200); undef $req; # Simulate when we instantiate Plack::Request multiple times # redo the test with the same $env $req = Plack::Request->new($env); @files = $req->upload('foo'); is scalar(@files), 2; is $files[0]->filename, 'foo1.txt'; ok -e $files[0]->tempname; $res->finalize; }; test_psgi $app, sub { my $cb = shift; $cb->(POST "/", Content_Type => 'form-data', Content => [ foo => [ "t/Plack-Request/foo1.txt" ], foo => [ "t/Plack-Request/foo2.txt" ], bar => [ "t/Plack-Request/foo1.txt" ], baz => "quux", ]); }; # Check if the temp files got cleaned up properly ok !-f $_ for @temp_files; done_testing; Plack-1.0039/t/Plack-Request/uri.t000644 000765 000024 00000006610 12631015706 017515 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Request; my @tests = ( { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "", }, uri => 'http://example.com/', parameters => {} }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "", PATH_INFO => "/foo bar", }, uri => 'http://example.com/foo%20bar', parameters => {} }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => '/test.c', }, uri => 'http://example.com/test.c', parameters => {} }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => '/test.c', PATH_INFO => '/info', }, uri => 'http://example.com/test.c/info', parameters => {} }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => '/test', QUERY_STRING => 'dynamic=daikuma', }, uri => 'http://example.com/test?dynamic=daikuma', parameters => { dynamic => 'daikuma' } }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => '/exec/' }, uri => 'http://example.com/exec/', parameters => {} }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => '/exec/' }, uri => 'http://example.com/exec/', parameters => {} }, { add_env => { SERVER_NAME => 'example.com' }, uri => 'http://example.com/', parameters => {} }, { add_env => {}, uri => 'http:///', parameters => {} }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "", QUERY_STRING => 'aco=tie' }, uri => 'http://example.com/?aco=tie', parameters => { aco => 'tie' } }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "", QUERY_STRING => "foo_only" }, uri => 'http://example.com/?foo_only', parameters => { foo_only => '' } }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "", QUERY_STRING => "foo&bar=baz" }, uri => 'http://example.com/?foo&bar=baz', parameters => { foo => '', bar => 'baz' } }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "", QUERY_STRING => "foo+bar" }, uri => 'http://example.com/?foo+bar', parameters => { 'foo bar' => '' } }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "", QUERY_STRING => 0 }, uri => 'http://example.com/?0', parameters => { 0 => '' } }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "/foo bar", PATH_INFO => "/baz quux", }, uri => 'http://example.com/foo%20bar/baz%20quux', parameters => {} }, { add_env => { HTTP_HOST => 'example.com', SCRIPT_NAME => "/path", PATH_INFO => "/parameters;path=one,two", QUERY_STRING => "query=foobar", }, uri => 'http://example.com/path/parameters;path=one,two?query=foobar', parameters => { query => "foobar" } }, ); plan tests => 2 * @tests; for my $block (@tests) { my $env = {SERVER_PORT => 80}; while (my($key, $val) = each %{ $block->{add_env} || {} }) { $env->{$key} = $val; } my $req = Plack::Request->new($env); is $req->uri, $block->{uri}; is_deeply $req->query_parameters, $block->{parameters}; }; Plack-1.0039/t/Plack-Request/uri_utf8.t000644 000765 000024 00000000512 12631015706 020456 0ustar00miyagawastaff000000 000000 use strict; use utf8; use Plack::Request; use HTTP::Request; use HTTP::Message::PSGI; use Test::More; my $path = "/Платежи"; my $hreq = HTTP::Request->new(GET => "http://localhost" . $path); my $req = Plack::Request->new($hreq->to_psgi); is $req->uri->path, '/%D0%9F%D0%BB%D0%B0%D1%82%D0%B5%D0%B6%D0%B8'; done_testing; Plack-1.0039/t/Plack-MIME/add_type.t000644 000765 000024 00000000412 12631015706 017600 0ustar00miyagawastaff000000 000000 use Plack::MIME; use Test::More; Plack::MIME->add_type(".foo" => "text/foo"); is( Plack::MIME->mime_type("bar.foo"), "text/foo" ); Plack::MIME->add_type(".c" => "application/c-source"); is( Plack::MIME->mime_type("FOO.C"), "application/c-source" ); done_testing; Plack-1.0039/t/Plack-MIME/basic.t000644 000765 000024 00000000346 12631015706 017076 0ustar00miyagawastaff000000 000000 use Plack::MIME; use Test::More; sub x($) { Plack::MIME->mime_type($_[0]) } is x ".gif", "image/gif"; is x "foo.png", "image/png"; is x "foo.GIF", "image/gif"; is x "foo.bar", undef; is x "foo.mp3", "audio/mpeg"; done_testing; Plack-1.0039/t/Plack-MIME/fallback.t000644 000765 000024 00000000427 12631015706 017554 0ustar00miyagawastaff000000 000000 use Test::More; use Test::Requires qw(MIME::Types); use Plack::MIME; use MIME::Types 'by_suffix'; is( Plack::MIME->mime_type(".vcd"), undef ); Plack::MIME->set_fallback(sub { (by_suffix $_[0])[0] }); is( Plack::MIME->mime_type(".vcd"), "application/x-cdlink" ); done_testing; Plack-1.0039/t/Plack-Middleware/access_log.t000644 000765 000024 00000004631 12631015706 021446 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common; use Plack::Test; use Plack::Builder; use POSIX; my $log; my $test = sub { my $format = shift; return sub { my $req = shift; my $app = builder { enable "Plack::Middleware::AccessLog", char_handlers => { z => sub { shift->{HTTP_X_FORWARDED_FOR}, } }, block_handlers => +{ Z => sub { my ($block,$env) = @_; $env->{$block} || '-' } }, logger => sub { $log = "@_" }, format => $format; sub { [ 200, [ 'Content-Type' => 'text/plain', 'Content-Length', 2 ], [ 'OK' ] ] }; }; test_psgi $app, sub { $_[0]->($req) }; }; }; { my $req = GET "http://example.com/"; $req->header("Host" => "example.com", "X-Forwarded-For" => "192.0.2.1"); my $fmt = "%P %{Host}i %p %{X-Forwarded-For}i %{Content-Type}o %{%m %y}t %v"; $test->($fmt)->($req); chomp $log; my $month_year = POSIX::strftime('%m %y', localtime); is $log, "$$ example.com 80 192.0.2.1 text/plain [$month_year] example.com"; } { $test->("%D")->(GET "/"); chomp $log; is $log, '-'; } { my $req = GET "http://example.com/"; my $fmt = "%r == %m %U%q %H"; $test->($fmt)->($req); chomp $log; my ($r, $rs) = split / == /, $log; is $r, $rs; } { my $req = GET "http://example.com/foo?bar=baz"; my $fmt = "%r == %m %U%q %H"; $test->($fmt)->($req); chomp $log; my ($r, $rs) = split / == /, $log; is $r, $rs; } { my $req = GET "http://example.com/foo?bar=baz", x_forwarded_for => 'herp derp'; my $fmt = "%m %z"; $test->($fmt)->($req); chomp $log; is $log, 'GET herp derp'; } { my $req = GET "http://example.com/foo?bar=baz", x_rand_r => 'station'; my $fmt = "%m %{HTTP_X_RAND_R}Z"; $test->($fmt)->($req); chomp $log; is $log, 'GET station'; } { my $req = POST "http://example.com/foo", [ "bar", "baz" ]; my $fmt = "cti=%{Content-Type}i cli=%{Content-Length}i cto=%{Content-Type}o clo=%{Content-Length}o"; $test->($fmt)->($req); chomp $log; my %vals = split /[= ]/, $log; is_deeply \%vals, { cti => "application/x-www-form-urlencoded", cli => 7, cto => 'text/plain', clo => 2 }; } done_testing; Plack-1.0039/t/Plack-Middleware/access_log_timed.t000644 000765 000024 00000005113 12631015706 022624 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common; use Plack::Test; use Plack::Builder; my $log; my $handler = builder { enable "Plack::Middleware::AccessLog::Timed", logger => sub { $log .= "@_" }; sub { [ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }; }; my $test_req = sub { my $req = shift; test_psgi app => $handler, client => sub { my $cb = shift; $cb->($req); }; }; { $test_req->(GET "http://localhost/"); like $log, qr@^127\.0\.0\.1 - - \[.*?\] "GET / HTTP/1\.1" 200 2@; } { $log = ""; $test_req->(POST "http://localhost/foo", { foo => "bar" }); like $log, qr@^127\.0\.0\.1 - - \[.*?\] "POST /foo HTTP/1\.1" 200 2@; } { $log = ""; $test_req->(GET "http://localhost/foo%20bar?baz=baz"); like $log, qr@GET /foo%20bar\?baz=baz HTTP/1\.1@; } # Testing delayed responses $log = ""; $handler = builder { enable "Plack::Middleware::AccessLog::Timed", logger => sub { $log .= "@_" }; sub { return sub { $_[0]->( [ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ] ) } }; }; $test_req = sub { my $req = shift; test_psgi app => $handler, client => sub { my $cb = shift; $cb->($req); }; }; { $test_req->(GET "http://localhost/"); like $log, qr@^127\.0\.0\.1 - - \[.*?\] "GET / HTTP/1\.1" 200 2@; } { $log = ""; $test_req->(POST "http://localhost/foo", { foo => "bar" }); like $log, qr@^127\.0\.0\.1 - - \[.*?\] "POST /foo HTTP/1\.1" 200 2@; } { $log = ""; $test_req->(GET "http://localhost/foo%20bar?baz=baz"); like $log, qr@GET /foo%20bar\?baz=baz HTTP/1\.1@; } # Testing streaming responses $log = ""; $handler = builder { enable "Plack::Middleware::AccessLog::Timed", logger => sub { $log .= "@_" }; sub { return sub { my $writer = $_[0]->( [ 200, [ 'Content-Type' => 'text/plain' ] ] ); $writer->write("OK"); $writer->close; } }; }; $test_req = sub { my $req = shift; test_psgi app => $handler, client => sub { my $cb = shift; $cb->($req); }; }; { $test_req->(GET "http://localhost/"); like $log, qr@^127\.0\.0\.1 - - \[.*?\] "GET / HTTP/1\.1" 200 2@; } { $log = ""; $test_req->(POST "http://localhost/foo", { foo => "bar" }); like $log, qr@^127\.0\.0\.1 - - \[.*?\] "POST /foo HTTP/1\.1" 200 2@; } { $log = ""; $test_req->(GET "http://localhost/foo%20bar?baz=baz"); like $log, qr@GET /foo%20bar\?baz=baz HTTP/1\.1@; } done_testing; Plack-1.0039/t/Plack-Middleware/access_log_value_zero.t000644 000765 000024 00000001372 12631015706 023700 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common; use Plack::Test; use Plack::Builder; use POSIX; my $log; my $test = sub { my $format = shift; return sub { my $req = shift; my $app = builder { enable "Plack::Middleware::AccessLog", logger => sub { $log = "@_" }, format => $format; sub { [ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }; }; test_psgi $app, sub { $_[0]->($req) }; }; }; { my $req = GET "http://example.com/"; $req->header("Zero" => "0"); my $fmt = "%{zero}i %{undef}i"; $test->($fmt)->($req); chomp $log; is $log, "0 -"; } { $test->("%D")->(GET "/"); chomp $log; is $log, '-'; } done_testing; Plack-1.0039/t/Plack-Middleware/auth_basic.t000644 000765 000024 00000001623 12631015706 021444 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Test; use Plack::Builder; use HTTP::Request::Common; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello $_[0]->{REMOTE_USER}" ] ] }; $app = builder { enable "Auth::Basic", authenticator => \&cb; $app; }; my %map = ( admin => 's3cr3t', john => 'foo:bar', ); sub cb { my($username, $password) = @_; return $map{$username} && $password eq $map{$username}; } test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/"); is $res->code, 401; my $req = GET "http://localhost/", "Authorization" => "Basic YWRtaW46czNjcjN0"; $res = $cb->($req); is $res->code, 200; is $res->content, "Hello admin"; $req = GET "http://localhost/", "Authorization" => "Basic am9objpmb286YmFy"; $res = $cb->($req); is $res->code, 200; is $res->content, "Hello john"; }; done_testing; Plack-1.0039/t/Plack-Middleware/auth_basic_env.t000644 000765 000024 00000002700 12631015706 022311 0ustar00miyagawastaff000000 000000 use Test::More; use Plack::Test; use Plack::Builder; use Plack::Request; use HTTP::Request::Common; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello $_[0]->{REMOTE_USER}" ] ] }; $app = builder { enable "Auth::Basic", authenticator => \&cb; $app; }; sub cb { my($username, $password, $env) = @_; my $req = Plack::Request->new($env); if ($req->path eq '/') { return $username eq 'admin' && $password eq 's3cr3t'; } else { return $username eq 'user' && $password eq 's0m3th1ngel5e'; } } test_psgi app => $app, client => sub { my $cb = shift; { my $res = $cb->(GET "http://localhost/"); is $res->code, 401; } { my $req = GET "http://localhost/", "Authorization" => "Basic YWRtaW46czNjcjN0"; my $res = $cb->($req); is $res->code, 200; is $res->content, "Hello admin"; } { my $req = GET "http://localhost/", "Authorization" => "Basic dXNlcjpzMG0zdGgxbmdlbDVl"; my $res = $cb->($req); is $res->code, 401; } { my $req = GET "http://localhost/foo", "Authorization" => "Basic YWRtaW46czNjcjN0"; my $res = $cb->($req); is $res->code, 401; } { my $req = GET "http://localhost/foo", "Authorization" => "Basic dXNlcjpzMG0zdGgxbmdlbDVl"; my $res = $cb->($req); is $res->code, 200; is $res->content, "Hello user"; } }; done_testing; Plack-1.0039/t/Plack-Middleware/auth_basic_simple.t000644 000765 000024 00000001455 12631015706 023020 0ustar00miyagawastaff000000 000000 use Test::More; use Test::Requires qw(Authen::Simple::Passwd); use Plack::Test; use Plack::Builder; use HTTP::Request::Common; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello $_[0]->{REMOTE_USER}" ] ] }; $app = builder { enable "Auth::Basic", authenticator => Authen::Simple::Passwd->new(path => "t/Plack-Middleware/htpasswd"); $app; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "http://localhost/"); is $res->code, 401; my $req = GET "http://localhost/", "Authorization" => "Basic YWRtaW46czNjcjN0"; $res = $cb->($req); is $res->code, 200; is $res->content, "Hello admin"; local $^W = 0; $req = GET "http://localhost/", "Authorization" => "Basic bogus"; $res = $cb->($req); is $res->code, 401; }; done_testing; Plack-1.0039/t/Plack-Middleware/bufferedstreaming.t000644 000765 000024 00000002065 12631015706 023037 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Builder; my @tests = ( { app => sub { return sub { $_[0]->([ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ]); }, }, env => { REQUEST_METHOD => 'GET' }, headers => [ 'Content-Type' => 'text/plain' ], body => 'OK', }, { app => sub { return sub { my $writer = $_[0]->([ 200, [ 'Content-Type' => 'text/plain' ]]); $writer->write("O"); $writer->write("K"); $writer->close(); }, }, env => { REQUEST_METHOD => 'GET' }, headers => [ 'Content-Type', 'text/plain' ], body => 'OK', }, ); plan tests => 2 * @tests; for my $block (@tests) { my $handler = builder { enable "BufferedStreaming"; $block->{app}; }; my $res = $handler->($block->{env}); is_deeply $res->[1], $block->{headers}, "headers passed through"; is join("", @{ $res->[2] }), $block->{body}, "body accumulated"; }; Plack-1.0039/t/Plack-Middleware/cascade/000755 000765 000024 00000000000 12631015706 020536 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Middleware/cgi-bin/000755 000765 000024 00000000000 12631015706 020463 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Middleware/cgibin.t000644 000765 000024 00000003333 12631015706 020575 0ustar00miyagawastaff000000 000000 use strict; use Test::More; plan skip_all => "release test only" unless $ENV{RELEASE_TESTING}; use Test::Requires { 'CGI::Emulate::PSGI' => 0.10, 'CGI::Compile' => 0.03 }; use Plack::Test; use HTTP::Request::Common; use Plack::App::CGIBin; my $app = Plack::App::CGIBin->new(root => "t/Plack-Middleware/cgi-bin")->to_app; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/hello.cgi?name=foo"); is $res->code, 200; is $res->content, "Hello foo counter=1"; $res = $cb->(GET "http://localhost/hello.cgi?name=bar"); is $res->code, 200; is $res->content, "Hello bar counter=2"; $res = $cb->(GET "http://localhost/hello2.cgi?name=foo"); is $res->code, 200; is $res->content, "Hello foo counter=1"; $res = $cb->(GET "http://localhost/hello3.cgi"); my $env = eval $res->content; is $env->{SCRIPT_NAME}, '/hello3.cgi'; is $env->{REQUEST_URI}, '/hello3.cgi'; $res = $cb->(GET "http://localhost/hello3.cgi/foo%20bar/baz"); is $res->code, 200; $env = eval $res->content || {}; is $env->{SCRIPT_NAME}, '/hello3.cgi'; is $env->{PATH_INFO}, '/foo bar/baz'; is $env->{REQUEST_URI}, '/hello3.cgi/foo%20bar/baz'; $res = $cb->(GET "http://localhost/hello4.cgi"); is $res->code, 404; $res = $cb->(GET "http://localhost/utf8.cgi"); is $res->code, 200; is length $res->content, 4; is $res->content, "\xe1\x83\xb7\n"; }; $app = Plack::App::CGIBin->new( root => "t/Plack-Middleware/cgi-bin", exec_cb => sub { 1 } )->to_app; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/cgi_dir.cgi"); is $res->code, 200; is $res->content, "MATCH"; }; done_testing; Plack-1.0039/t/Plack-Middleware/cgibin_exec.t000644 000765 000024 00000003513 12631015706 021601 0ustar00miyagawastaff000000 000000 use strict; use Test::More; plan skip_all => "release test only" unless $ENV{RELEASE_TESTING}; use Test::Requires { 'CGI::Emulate::PSGI' => 0.10, 'CGI::Compile' => 0.03 }; use Plack::Test; use HTTP::Request::Common; use Plack::App::CGIBin; unless (-e "/usr/bin/python" && -x _) { plan skip_all => "You don't have /usr/bin/python"; } if (`/usr/bin/python --version 2>&1` =~ /^Python 3/) { plan skip_all => "This test doesn't support python 3 yet"; } my $app = Plack::App::CGIBin->new(root => "t/Plack-Middleware/cgi-bin")->to_app; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/hello.py?name=foo"); is $res->code, 200; like $res->content, qr/Hello foo/; like $res->content, qr/QUERY_STRING is name=foo/; }; # test that current directory is same the script directory { use File::Basename qw/basename dirname/; my $tmp = File::Temp->new(CLEANUP => 1); print $tmp <<"..."; #!$^X use CGI; use File::Basename qw/dirname/; use Cwd; my \$cgi_dir = Cwd::abs_path( dirname( __FILE__ ) ); my \$exec_dir = Cwd::abs_path( Cwd::getcwd ); my \$result = \$cgi_dir eq \$exec_dir ? "MATCH" : "DIFFERENT"; if (\$result ne "MATCH") { \$result .= "\nCGI_DIR: \$cgi_dir\nEXEC_DIR: \$exec_dir\n"; } my \$q = CGI->new; print \$q->header(-type => "text/plain"), \$result; ... close $tmp; chmod(oct("0700"), $tmp->filename) or die "Cannot chmod"; my $cgi_dir = dirname( $tmp->filename ); my $cgi_name = basename( $tmp->filename ); my $app_exec = Plack::App::CGIBin->new( root => $cgi_dir, exec_cb => sub { 1 } )->to_app; test_psgi app => $app_exec, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/$cgi_name?"); is $res->code, 200; is $res->content, "MATCH"; }; undef $tmp; }; done_testing; Plack-1.0039/t/Plack-Middleware/chunked.t000644 000765 000024 00000003100 12631015706 020753 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Test::Requires qw(IO::Handle::Util LWP::UserAgent LWP::Protocol::http10); use IO::Handle::Util qw(:io_from); use HTTP::Request::Common; use Plack::Test; use Plack::Middleware::Chunked; $Plack::Test::Impl = "Server"; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my @app = ( sub { [ 200, [], [ 'Hello World' ] ] }, sub { [ 200, [], [ 'Hello ', 'World' ] ] }, sub { [ 200, [], [ 'Hello ', '', 'World' ] ] }, sub { [ 200, [], io_from_array [ 'Hello World' ] ] }, sub { [ 200, [], io_from_array [ 'Hello', ' World' ] ] }, sub { [ 200, [], io_from_array [ 'Hello', '', ' World' ] ] }, ); @app = (@app, @app); # for 1.0 and 1.1 my $app = sub { (shift @app)->(@_) }; test_psgi ua => LWP::UserAgent->new, # force LWP app => Plack::Middleware::Chunked->wrap($app), client => sub { my $cb = shift; for my $proto (qw( HTTP/1.1 HTTP/1.0 )) { my $is_http_10 = $proto eq 'HTTP/1.0'; if ($is_http_10) { LWP::Protocol::implementor('http', 'LWP::Protocol::http10'); } for (1..@app/2) { my $req = GET "http://localhost/"; $req->protocol($proto); my $res = $cb->($req); is $res->content, 'Hello World'; is $res->decoded_content, 'Hello World'; if ($is_http_10) { isnt $res->header('client-transfer-encoding'), 'chunked', 'Chunked shouldn\'t be used in HTTP/1.0'; } else { is $res->header('client-transfer-encoding'), 'chunked'; } } } }; done_testing; Plack-1.0039/t/Plack-Middleware/component-leak.t000644 000765 000024 00000002421 12631015706 022253 0ustar00miyagawastaff000000 000000 package MyComponent; use strict; use warnings; use Test::More; use Scalar::Util qw/weaken/; use parent 'Plack::Component'; sub call { my $self = shift; my $env = shift; if( $env->{PATH_INFO} eq '/run_response_cb' ){ my $my; # Record $res and $cb $self->{res} = [200, ['Content-Type' => 'text/plain'], ['OK']]; $self->{cb} = sub { $my }; # Contain $my to be regard as a closure. return $self->response_cb($self->{res}, $self->{cb}); }else{ # Decrease REFCNT weaken $self->{res}; weaken $self->{cb}; # Check if references are released. return [ 200, [ 'Content-Type' => 'text/plain', 'X-Res-Freed' => ! $self->{res}, 'X-Cb-Freed' => ! $self->{cb}, ], ['HELLO'] ]; } } package main; use strict; use warnings; use Test::More; use Plack::Test; use HTTP::Request::Common; $Plack::Test::Impl = "Server"; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my $app = MyComponent->new; test_psgi( $app->to_app, sub { my $cb = shift; $cb->(GET '/run_response_cb'); my $req = $cb->(GET '/check'); ok $req->header('X-Res-Freed'), '$res has been released.'; ok $req->header('X-Cb-Freed') , '$cb has been released.'; } ); done_testing; Plack-1.0039/t/Plack-Middleware/component.t000644 000765 000024 00000003047 12631015706 021346 0ustar00miyagawastaff000000 000000 use strict; use Test::Requires qw(IO::Handle::Util); package MyComponent; use parent 'Plack::Component'; use Plack::Util::Accessor qw( res cb ); sub call { return $_[0]->response_cb( $_[0]->res, $_[0]->cb ); } package main; use IO::Handle::Util qw(:io_from); use HTTP::Request::Common; use Test::More; use Plack::Test; # Various kinds of PSGI responses. sub generate_responses { [200, ['Content-Type' => 'text/plain'], ['Hello']], [200, ['Content-Type' => 'text/plain'], io_from_array ['Hello']], sub { $_[0]->([ 200, ['Content-Type' => 'text/plain'], ['Hello'] ]) }, sub { my $writer = $_[0]->([ 200, ['Content-Type' => 'text/plain'] ]); $writer->write( 'Hello' ); $writer->close; }, } # $body filters can return undef with no warnings. for my $res ( generate_responses ) { my @warns; local $SIG{__WARN__} = sub { push @warns, @_ }; my $app = MyComponent->new( res => $res, cb => sub { sub { $_[0] } }, ); test_psgi( $app, sub { $_[0]->(GET '/') } ); is_deeply \@warns, []; } for my $res ( generate_responses ) { my $app = MyComponent->new( res => $res, cb => sub { my $done; sub { return if $done; if (defined $_[0]) { return $_[0]; } else { $done = 1; return 'END'; } }, }, ); test_psgi( $app, sub { my $res = $_[0]->(GET '/'); is $res->content, 'HelloEND'; } ); } done_testing; Plack-1.0039/t/Plack-Middleware/conditional.t000644 000765 000024 00000001653 12631015706 021650 0ustar00miyagawastaff000000 000000 use strict; no warnings; use Plack::Test; use Plack::Builder; use Test::More; use HTTP::Request::Common; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello' ] ] }; $app = builder { enable_if { $_[0]->{HTTP_X_FOO} =~ /Bar/i } 'XFramework', framework => 'Testing'; enable_if { $_[0]->{HTTP_X_ALLCAPS} } sub { my $app = shift; sub { my $res = $app->($_[0]); $res->[2] = [ map uc $_, @{$res->[2]} ]; $res }; }; $app; }; test_psgi app => $app, client => sub { my $cb = shift; my($req, $res); $req = GET "http://localhost/"; $res = $cb->($req); ok !$res->header('X-Framework'); $req = GET "http://localhost/", 'X-Foo' => 'Bar'; $res = $cb->($req); like $res->header('X-Framework'), qr/Testing/; $req = GET "http://localhost/", 'X-AllCaps' => 1; $res = $cb->($req); is $res->content, 'HELLO'; }; done_testing; Plack-1.0039/t/Plack-Middleware/conditional_new.t000644 000765 000024 00000002254 12631015706 022517 0ustar00miyagawastaff000000 000000 use strict; no warnings; use Plack::Test; use Plack::Builder; use Test::More; use HTTP::Request::Common; use Plack::Middleware::Conditional; use Plack::Middleware::XFramework; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello' ] ] }; my $mw1 = Plack::Middleware::Conditional->new( condition => sub { $_[0]->{HTTP_X_FOO} =~ /Bar/i }, builder => sub { Plack::Middleware::XFramework->new(framework => 'Testing')->wrap($_[0]) }, ); my $mw2 = Plack::Middleware::Conditional->new( condition => sub { $_[0]->{HTTP_X_ALLCAPS} }, builder => sub { my $app = shift; sub { my $res = $app->($_[0]); $res->[2] = [ map uc $_, @{$res->[2]} ]; $res }; }, ); $app = $mw2->wrap($app); $app = $mw1->wrap($app); test_psgi app => $app, client => sub { my $cb = shift; my($req, $res); $req = GET "http://localhost/"; $res = $cb->($req); ok !$res->header('X-Framework'); $req = GET "http://localhost/", 'X-Foo' => 'Bar'; $res = $cb->($req); like $res->header('X-Framework'), qr/Testing/; $req = GET "http://localhost/", 'X-AllCaps' => 1; $res = $cb->($req); is $res->content, 'HELLO'; }; done_testing; Plack-1.0039/t/Plack-Middleware/conditionalget.t000644 000765 000024 00000004211 12631015706 022341 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Plack::Builder; use Test::More; my @tests = ( { app => sub { [ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => 'GET' }, status => 200, headers => [ 'Content-Type', 'text/plain' ], }, { app => sub { [ 200, [ 'ETag' => 'Foo', 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_NONE_MATCH => "Foo" }, status => 304, headers => [ ETag => 'Foo' ], }, { app => sub { [ 200, [ 'Last-Modified' => 'Wed, 23 Sep 2009 13:36:33 GMT', 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_MODIFIED_SINCE => "Wed, 23 Sep 2009 13:36:33 GMT" }, status => 304, headers => [ "Last-Modified" => "Wed, 23 Sep 2009 13:36:33 GMT" ], }, { app => sub { [ 200, [ 'Last-Modified' => 'Wed, 23 Sep 2009 13:36:33 GMT', 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_MODIFIED_SINCE => "Wed, 23 Sep 2009 13:36:32 GMT" }, status => 200, headers => [ "Last-Modified", "Wed, 23 Sep 2009 13:36:33 GMT", "Content-Type", "text/plain", ], }, { app => sub { [ 200, [ 'Last-Modified' => 'Wed, 23 Sep 2009 13:36:33 GMT', 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_MODIFIED_SINCE => "Wed, 23 Sep 2009 13:36:33 GMT; length=2" }, status => 304, headers => [ "Last-Modified", "Wed, 23 Sep 2009 13:36:33 GMT" ], }, { app => sub { [ 200, [ 'ETag' => 'Foo', 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "POST", HTTP_IF_NONE_MATCH => "Foo" }, status => 200, headers => [ ETag => "Foo", "Content-Type" => "text/plain" ], } ); plan tests => 2*@tests; for my $block (@tests) { my $handler = builder { enable "Plack::Middleware::ConditionalGET"; $block->{app}; }; my $res = $handler->($block->{env}); is $res->[0], $block->{status}; is_deeply $res->[1], $block->{headers}; } Plack-1.0039/t/Plack-Middleware/conditionalget_writer.t000644 000765 000024 00000001632 12631015706 023741 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Builder; use HTTP::Request::Common; use Plack::Test; my $handler = builder { enable 'ConditionalGET'; sub { my $env = shift; return sub { my $writer = shift->( [ 200, [ 'Content-Type' => 'text/plain', 'ETag' => 'DEADBEEF', ] ] ); $writer->write($_) for ( qw( kling klang klong ) ); $writer->close; }; }; }; test_psgi $handler, sub { my $cb = shift; my $res = $cb->( GET "http://localhost/streaming-klingklangklong" ); is $res->code, 200, 'Response HTTP status'; is $res->content, 'klingklangklong', 'Response content'; $res = $cb->( GET "http://localhost/streaming-klingklangklong", 'If-None-Match' => 'DEADBEEF' ); is $res->code, 304, 'Response HTTP status'; ok(!$res->content); }; done_testing; Plack-1.0039/t/Plack-Middleware/content_length.t000644 000765 000024 00000002775 12631015706 022366 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Builder; my @tests = ( { app => sub { [ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => 'GET' }, headers=> [ 'Content-Type' => 'text/plain', 'Content-Length' => 2 ], }, { app => sub { open my $fh, "<", "share/baybridge.jpg"; [ 200, [ 'Content-Type' => 'image/jpeg' ], $fh ]; }, env => { REQUEST_METHOD => 'GET' }, headers => [ 'Content-Type' => 'image/jpeg', 'Content-Length' => 14750 ], }, { app => sub { [ 304, [ ETag => 'Foo' ], [] ]; }, env => { REQUEST_METHOD => 'GET' }, headers => [ ETag => 'Foo' ], }, { app => sub { my $body = "Hello World"; open my $fh, "<", \$body; [ 200, [ 'Content-Type' => 'text/plain' ], $fh ]; }, env => { REQUEST_METHOD => 'GET' }, headers => [ 'Content-Type' => 'text/plain' ], }, { app => sub { [ 200, [ 'Content-Type' => 'text/plain', 'Content-Length' => 11 ], [ "Hello World" ] ]; }, env => { REQUEST_METHOD => 'GET' }, headers => [ 'Content-Type' => 'text/plain', 'Content-Length', 11 ], }, ); plan tests => 1 * @tests; for my $block (@tests) { my $handler = builder { enable "Plack::Middleware::ContentLength"; $block->{app}; }; my $res = $handler->($block->{env}); is_deeply $res->[1], $block->{headers}; }; Plack-1.0039/t/Plack-Middleware/directory.t000644 000765 000024 00000002324 12631015706 021345 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common; use HTTP::Response; use Plack::Test; use Plack::App::Directory; my $handler = Plack::App::Directory->new({ root => 'share' }); my %test = ( client => sub { my $cb = shift; # URI-escape my $res = $cb->(GET "http://localhost/"); my($ct, $charset) = $res->content_type; ok $res->content =~ m{/%23foo}; $res = $cb->(GET "/.."); is $res->code, 403; $res = $cb->(GET "/..%00foo"); is $res->code, 400; $res = $cb->(GET "/..%5cfoo"); is $res->code, 403; $res = $cb->(GET "/"); like $res->content, qr/Index of \//; SKIP: { skip "Filenames can't end with . on windows", 2 if $^O eq "MSWin32"; mkdir "share/stuff..", 0777; open my $out, ">", "share/stuff../Hello.txt" or die $!; print $out "Hello\n"; close $out; $res = $cb->(GET "/stuff../Hello.txt"); is $res->code, 200; is $res->content, "Hello\n"; unlink "share/stuff../Hello.txt"; rmdir "share/stuff.."; } }, app => $handler, ); test_psgi %test; done_testing; Plack-1.0039/t/Plack-Middleware/error_document.t000644 000765 000024 00000002133 12631015706 022366 0ustar00miyagawastaff000000 000000 use strict; use warnings; use FindBin; use Test::More; use HTTP::Request::Common; use Plack::Test; use Plack::Builder; my $handler = builder { enable "Plack::Middleware::ErrorDocument", 500 => "$FindBin::Bin/errors/500.html"; enable "Plack::Middleware::ErrorDocument", 404 => "/errors/404.html", subrequest => 1; enable "Plack::Middleware::Static", path => qr{^/errors}, root => $FindBin::Bin; sub { my $env = shift; my $status = ($env->{PATH_INFO} =~ m!status/(\d+)!)[0] || 200; [ $status, [ 'Content-Type' => 'text/plain' ], [ "Error: $status" ] ]; }; }; test_psgi app => $handler, client => sub { my $cb = shift; { my $res = $cb->(GET "http://localhost/"); is $res->code, 200; $res = $cb->(GET "http://localhost/status/500"); is $res->code, 500; like $res->content, qr/fancy 500/; $res = $cb->(GET "http://localhost/status/404"); is $res->code, 404; like $res->header('content_type'), qr!text/html!; like $res->content, qr/fancy 404/; } }; done_testing; Plack-1.0039/t/Plack-Middleware/error_document_streaming_app.t000644 000765 000024 00000004307 12631015706 025304 0ustar00miyagawastaff000000 000000 use strict; use warnings; use FindBin; use Test::More; use HTTP::Request::Common; use Plack::Test; use Plack::Builder; $Plack::Test::Impl = undef; my @impl = ('Server', 'MockHTTP'); sub flip_backend { push @impl, $Plack::Test::Impl; $Plack::Test::Impl = shift @impl; } { my $handler = builder { enable "Plack::Middleware::ErrorDocument", 404 => "$FindBin::Bin/errors/404.html"; sub { my $env = shift; my $status = ($env->{PATH_INFO} =~ m!status/(\d+)!)[0] || 200; return sub { my $r = shift; my $w = $r->([ $status, [ 'Content-Type' => 'text/plain' ]]); $w->write("Error: $status\n"); $w->close; }; }; }; test_psgi app => $handler, client => sub { my $cb = shift; { my $res = $cb->(GET "http://localhost/"); is $res->code, 200; $res = $cb->(GET "http://localhost/status/404"); is $res->code, 404; like $res->header('content_type'), qr!text/html!; like $res->content, qr/fancy 404/; } } while flip_backend; } { my $handler = builder { enable "Plack::Middleware::ErrorDocument", 404 => "/404", subrequest => 1; mount '/404' => sub { [200, ['Content-Type' => 'text/html'], [< sub { my $env = shift; my $status = ($env->{PATH_INFO} =~ m!status/(\d+)!)[0] || 200; return sub { my $r = shift; my $w = $r->([ $status, [ 'Content-Type' => 'text/plain' ]]); $w->write("Error: $status\n"); $w->close; }; }; }; test_psgi app => $handler, client => sub { my $cb = shift; { my $res = $cb->(GET "http://localhost/"); is $res->code, 200; $res = $cb->(GET "http://localhost/status/404"); is $res->code, 404; like $res->header('content_type'), qr!text/html!; like $res->content, qr/fancy 404/; } } while flip_backend; } done_testing; Plack-1.0039/t/Plack-Middleware/errors/000755 000765 000024 00000000000 12631015706 020467 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Middleware/file.t000644 000765 000024 00000002405 12631015706 020260 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::More; use HTTP::Request::Common; use Plack::App::File; use FindBin qw($Bin); my $app = Plack::App::File->new(file => 'Changes'); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200; like $res->content, qr/Plack/; $res = $cb->(GET "/whatever"); is $res->content_type, 'text/plain'; is $res->code, 200; }; my $app_content_type = Plack::App::File->new( file => 'Changes', content_type => 'text/x-changes' ); test_psgi $app_content_type, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200; like $res->content, qr/Plack/; $res = $cb->(GET "/whatever"); is $res->content_type, 'text/x-changes'; is $res->code, 200; }; my $app_secure = Plack::App::File->new(root => $Bin); test_psgi $app_secure, sub { my $cb = shift; my $res = $cb->(GET "/file.t"); is $res->code, 200; like $res->content, qr/We will find for this literal string/; my $res = $cb->(GET "/../Plack-Middleware/file.t"); is $res->code, 403; is $res->content, 'forbidden'; for my $i (1..100) { $res = $cb->(GET "/file.t" . ("/" x $i)); is $res->code, 404; is $res->content, 'not found'; } }; done_testing; Plack-1.0039/t/Plack-Middleware/head.t000644 000765 000024 00000000776 12631015706 020253 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use Plack::Builder; use HTTP::Request::Common; my $app = sub { my $env = shift; my $body = "Hello World"; [ 200, [ 'Content-Type', 'text/plain', 'Content-Length', length($body) ], [ $body ] ]; }; $app = builder { enable "Head"; $app }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->content, "Hello World"; $res = $cb->(HEAD "/"); ok !$res->content; is $res->content_length, 11; }; done_testing; Plack-1.0039/t/Plack-Middleware/head_streaming.t000644 000765 000024 00000001070 12631015706 022310 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use Plack::Builder; use HTTP::Request::Common; my $app = sub { my $env = shift; return sub { my $writer = shift->( [ 200, [ 'Content-Type' => 'text/plain', ] ] ); $writer->write($_) for qw{Hello World}; $writer->close; }; }; $app = builder { enable "Head"; $app }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->content, "HelloWorld"; $res = $cb->(HEAD "/"); ok !$res->content; ok(!$res->content_length); }; done_testing; Plack-1.0039/t/Plack-Middleware/htpasswd000644 000765 000024 00000000024 12631015706 020727 0ustar00miyagawastaff000000 000000 admin:6iSeSVcVHgNQw Plack-1.0039/t/Plack-Middleware/httpexceptions.t000644 000765 000024 00000002777 12631015706 022436 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use HTTP::Request::Common; use Test::More; package HTTP::Error; sub new { bless {}, shift } sub throw { my $class = shift; die $class->new; } package HTTP::Error::InternalServerError; use base qw(HTTP::Error); sub code { 500 } package HTTP::Error::Forbidden; use base qw(HTTP::Error); sub code { 403 } sub as_string { "blah blah blah" } package HTTP::Error::Redirect; use base qw(HTTP::Error); sub code { 302 } sub location { "http://somewhere/else" } package main; my $psgi_errors; my $app = sub { my $env = shift; $env->{'psgi.errors'} = do { open my $io, ">>", \$psgi_errors; $io }; if ($env->{PATH_INFO} eq '/secret') { HTTP::Error::Forbidden->throw; } if ($env->{PATH_INFO} eq '/redirect') { HTTP::Error::Redirect->throw; } if ($env->{PATH_INFO} eq '/uncaught') { die 'ugly stack trace here'; } HTTP::Error::InternalServerError->throw; }; use Plack::Middleware::HTTPExceptions; $app = Plack::Middleware::HTTPExceptions->wrap($app); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 500; is $res->content, 'Internal Server Error'; $res = $cb->(GET "/secret"); is $res->code, 403; is $res->content, 'blah blah blah'; $res = $cb->(GET '/redirect'); is $res->code, 302; is $res->header('Location'), 'http://somewhere/else'; $res = $cb->(GET '/uncaught'); is $res->code, 500; like $psgi_errors, qr/ugly stack trace here/; }; done_testing; Plack-1.0039/t/Plack-Middleware/httpexceptions_streaming.t000644 000765 000024 00000002362 12631015706 024475 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use HTTP::Request::Common; use Test::More; package HTTP::Error; sub new { bless {}, shift } sub throw { my $class = shift; die $class->new; } package HTTP::Error::InternalServerError; use base qw(HTTP::Error); sub code { 500 } package HTTP::Error::Forbidden; use base qw(HTTP::Error); sub code { 403 } sub as_string { "blah blah blah" } package main; my $app = sub { my $env = shift; if ($env->{PATH_INFO} eq '/secret') { return sub { HTTP::Error::Forbidden->throw }; } elsif ($env->{PATH_INFO} eq '/ok') { return sub { my $res = shift; my $w = $res->([ 200, [ 'Content-Type', 'text/plain' ] ]); $w->write("Hello"); $w->close; }; } return sub { HTTP::Error::InternalServerError->throw }; }; use Plack::Middleware::HTTPExceptions; $app = Plack::Middleware::HTTPExceptions->wrap($app); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 500; is $res->content, 'Internal Server Error'; $res = $cb->(GET "/secret"); is $res->code, 403; is $res->content, 'blah blah blah'; $res = $cb->(GET "/ok"); is $res->code, 200; is $res->content, 'Hello'; }; done_testing; Plack-1.0039/t/Plack-Middleware/iis6_script_name_fix.t000644 000765 000024 00000004164 12631015706 023451 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Middleware::IIS6ScriptNameFix; my %env = ( 'SCRIPT_NAME' => '/koo/blurb', 'PATH_INFO' => '/koo/blurb', 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8', 'REQUEST_METHOD' => 'GET', 'SCRIPT_FILENAME' => 'C:\\Foo\\script\\blurb', 'INSTANCE_META_PATH' => '/LM/W3SVC/793536', 'SERVER_SOFTWARE' => 'Microsoft-IIS/6.0', 'AUTH_PASSWORD' => '', 'AUTH_TYPE' => '', 'HTTP_USER_AGENT' => 'Mozilla/5.0 (Windows; U; Windows NT 5.2; de; rv:1.9.0.4) Gecko/2008102920 Firefox/3.0.4 (.NET CLR 3.5.30729)', 'REMOTE_PORT' => '1281', 'QUERY_STRING' => '', 'URL' => '/koo/blurb', 'HTTP_ACCEPT_LANGUAGE' => 'de-de,de;q=0.8,en-us;q=0.5,en;q=0.3', 'FCGI_ROLE' => 'RESPONDER', 'HTTP_KEEP_ALIVE' => '300', 'CONTENT_TYPE' => '', 'LOCAL_ADDR' => '127.0.0.1', 'GATEWAY_INTERFACE' => 'CGI/1.1', 'HTTPS' => 'off', 'DOCUMENT_ROOT' => 'C:\\Foo\\script', 'REMOTE_HOST' => '127.0.0.1', 'PATH_TRANSLATED' => 'C:\\Foo\\script\\blurb', 'APPL_PHYSICAL_PATH' => 'C:\\Foo\\script\\', 'SERVER_NAME' => '127.0.0.1', 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate', 'HTTP_CONNECTION' => 'keep-alive', 'INSTANCE_ID' => '793536', 'CONTENT_LENGTH' => '0', 'AUTH_USER' => '', 'APPL_MD_PATH' => '/LM/W3SVC/793536/Root/koo', 'HTTP_ACCEPT_CHARSET' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7', 'REMOTE_USER' => '', 'SERVER_PORT_SECURE' => '0', 'SERVER_PORT' => 83, 'REMOTE_ADDR' => '127.0.0.1', 'SERVER_PROTOCOL' => 'HTTP/1.1', 'REQUEST_URI' => '/koo/blurb', 'APP_POOL_ID' => 'DefaultAppPool', 'HTTP_HOST' => '127.0.0.1:83' ); sub test_fix { my ($input_env) = @_; my $mangled_env; Plack::Middleware::IIS6ScriptNameFix->wrap(sub { my ($env) = @_; $mangled_env = $env; return [ 200, ['Content-Type' => 'text/plain'], [''] ]; })->($input_env); return $mangled_env; } my $fixed_env = test_fix({ %env }); is($fixed_env->{PATH_INFO}, '//blurb', 'check PATH_INFO'); is($fixed_env->{SCRIPT_NAME}, '/koo', 'check SCRIPT_NAME'); done_testing; Plack-1.0039/t/Plack-Middleware/iis7_keep_alive_fix.t000644 000765 000024 00000001617 12631015706 023252 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use HTTP::Request::Common; use Plack::Middleware::IIS7KeepAliveFix; my $app=Plack::Middleware::IIS7KeepAliveFix->wrap( sub { my $env = shift; my $location='/go/?'.join('|', (0..1000)); return [ 302, [ 'Content-Type' => 'text/html', 'Content-Length' => 285, 'Location' => $location, ],[qq~ Moved

This item has moved here.

~] ]; }); test_psgi(app=>$app,client=> sub { my $cb = shift; my $res = $cb->(GET "/"); ok(!$res->content); ok(!$res->content_length); ok(!$res->content_type); }); done_testing; Plack-1.0039/t/Plack-Middleware/jsonp.t000644 000765 000024 00000002612 12631015706 020472 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use Plack::Builder; my @json = ('{"foo":', '"bar"}'); my $json = join '', @json; my @tests = ( { callback_key => 'json.p', app => sub { return [ 200, [ 'Content-Type' => 'application/json' ], [@json] ]; }, }, { app => sub { return sub { my $respond = shift; $respond->( [ 200, [ 'Content-Type' => 'application/json' ], [$json] ] ); }; }, } ); for my $test ( @tests ) { my $app = $test->{app}; if ( exists $test->{callback_key} ) { $app = builder { enable "Plack::Middleware::JSONP", callback_key => $test->{callback_key}; $app; }; } else { $app = builder { enable "Plack::Middleware::JSONP"; $app; }; } my $callback_key = $test->{callback_key} || 'callback'; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(HTTP::Request->new(GET => 'http://localhost/')); is $res->content_type, 'application/json'; is $res->content, $json; $res = $cb->(HTTP::Request->new(GET => 'http://localhost/?'.$callback_key.'=foo')); is $res->content_type, 'text/javascript'; is $res->content, "/**/foo($json)"; }; } done_testing; Plack-1.0039/t/Plack-Middleware/lint.t000644 000765 000024 00000003452 12631015706 020312 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::More; use HTTP::Request::Common; use Plack::Builder; use Plack::Middleware::Lint; my @bad = map { Plack::Middleware::Lint->wrap($_) } ( sub { return {} }, sub { return [ 200, [], [], [] ] }, sub { return [ 200, {}, [] ] }, sub { return [ 0, [], "Hello World" ] }, sub { return [ 200, [], [ "\x{1234}" ] ] }, sub { return [ 200, [], {} ] }, sub { return [ 200, [], undef ] }, sub { return [ 200, [ "Foo:", "bar" ], [ "Hello" ] ] }, sub { return [ 200, [ "Foo-", "bar" ], [ "Hello" ] ] }, sub { return [ 200, [ "0xyz", "bar" ], [ "Hello" ] ] }, sub { return [ 200, [ "Status", "201" ], [ "Hi" ] ] }, sub { return [ 200, [ "Foo\nBar", "baz" ], [ '' ] ] }, sub { return [ 200, [ "Location", "Foo\nBar" ], [] ] }, sub { return [ 200, [ "Foo" ], [ "Hello" ] ] }, sub { return sub { shift->([ 200, [], {} ]) } }, sub { return sub { shift->([ 200, [], undef ]) } }, sub { return [ 200, [ "X-Foo", undef ], [ "Hi" ] ] }, ); my @good = map { Plack::Middleware::Lint->wrap($_) } ( sub { open my $io, "<", \"foo"; return [ 200, [ "Content-Type", "text/plain" ], $io ]; }, sub { my $body = "L\x{e9}on"; utf8::upgrade $body; return [ 200, [ "Content-Type", "text/html; charset=latin-1" ], [ $body ] ]; }, ); push @bad, builder { enable sub { my $app = shift; sub { $_[0]->{SCRIPT_NAME} = '/'; $app->(@_) } }; enable "Lint"; $good[0]; }; for my $app (@bad) { test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 500, $res->content; }; } for my $app (@good) { test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200, $res->content; }; } done_testing; Plack-1.0039/t/Plack-Middleware/lint_env.t000644 000765 000024 00000002255 12631015706 021162 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Middleware::Lint; use HTTP::Message::PSGI qw(req_to_psgi); use HTTP::Request; my $app = sub { [ 200, [ 'Content-Type' => 'text/plain' ], [ "OK" ] ]; }; $app = Plack::Middleware::Lint->wrap($app); my @good_env = ( { PATH_INFO => '' }, ); my @bad_env = ( [ { REQUEST_METHOD => undef }, qr/Missing env param: REQUEST_METHOD/ ], [ { REQUEST_METHOD => "foo" },, qr/Invalid env param: REQUEST_METHOD/ ], [ { PATH_INFO => 'foo' }, qr/PATH_INFO must begin with \// ], [ { SERVER_PORT => undef }, qr/Missing mandatory .*SERVER_PORT/ ], [ { SERVER_PROTOCOL => 'HTTP/x' }, qr/Invalid SERVER_PROTOCOL/ ], [ { "psgi.version" => 2 }, qr/psgi\.version should be ArrayRef/ ], [ { HTTP_CONTENT_TYPE => "text/plain" }, qr/HTTP_CONTENT_TYPE should not exist/ ], ); for my $good (@good_env) { my $env = req_to_psgi( HTTP::Request->new(GET => "/") ); eval { $app->({ %$env, %$good }); }; ok !$@; } for my $bad (@bad_env) { my($inject, $err) = @$bad; my $env = req_to_psgi( HTTP::Request->new(GET => "/") ); eval { $app->({ %$env, %$inject }); }; like $@, $err, $err; } done_testing; Plack-1.0039/t/Plack-Middleware/lint_utf8_false_alarm.t000644 000765 000024 00000000752 12631015706 023606 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::More; use HTTP::Request::Common; use Plack::Middleware::Lint; my @good = map { Plack::Middleware::Lint->wrap($_) } ( sub { my $body = "abc"; utf8::upgrade($body); return [ 200, [ "Content-Type", "text/plain;charset=utf-8"], [ $body ] ]; }, ); for my $app (@good) { test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200, $res->content; }; } done_testing; Plack-1.0039/t/Plack-Middleware/log4perl-category.t000644 000765 000024 00000002011 12631015706 022675 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::Requires qw(Log::Log4perl); use Test::More; use Plack::Middleware::Log4perl; use HTTP::Request::Common; my $test_file = "t/Plack-Middleware/log4perl.log"; my $conf = <{'psgix.logger'}->({ level => "debug", message => "This is debug" }); $env->{'psgix.logger'}->({ level => "info", message => "This is info" }); return [ 200, [], [] ]; }; $app = Plack::Middleware::Log4perl->wrap($app, category => '0'); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); my $log = do { open my $fh, "<", $test_file; join '', <$fh>; }; like $log, qr/INFO - This is info/; unlike $log, qr/debug/; }; END { unlink $test_file } done_testing; Plack-1.0039/t/Plack-Middleware/log4perl.t000644 000765 000024 00000002033 12631015706 021066 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::Requires qw(Log::Log4perl); use Test::More; use Plack::Middleware::Log4perl; use HTTP::Request::Common; my $test_file = "t/Plack-Middleware/log4perl.log"; my $conf = <{'psgix.logger'}->({ level => "debug", message => "This is debug" }); $env->{'psgix.logger'}->({ level => "info", message => "This is info" }); return [ 200, [], [] ]; }; $app = Plack::Middleware::Log4perl->wrap($app, category => 'plack.test'); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); my $log = do { open my $fh, "<", $test_file; join '', <$fh>; }; like $log, qr/INFO - This is info/; unlike $log, qr/debug/; }; END { unlink $test_file } done_testing; Plack-1.0039/t/Plack-Middleware/log_dispatch.t000644 000765 000024 00000002312 12631015706 021776 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::Requires { 'Log::Dispatch' => 2.25, 'Log::Dispatch::Array' => 1.001 }; use Test::More; use Plack::Middleware::LogDispatch; use HTTP::Request::Common; use Log::Dispatch; use Log::Dispatch::Array; package Stringify; use overload q{""} => sub { 'stringified object' }; sub new { bless {}, shift } package main; my @logs; my $logger = Log::Dispatch->new; $logger->add(Log::Dispatch::Array->new( min_level => 'debug', array => \@logs, )); my $app = sub { my $env = shift; $env->{'psgix.logger'}->({ level => "debug", message => "This is debug" }); $env->{'psgix.logger'}->({ level => "info", message => sub { 'code ref' } }); $env->{'psgix.logger'}->({ level => "notice", message => Stringify->new() }); return [ 200, [], [] ]; }; $app = Plack::Middleware::LogDispatch->wrap($app, logger => $logger); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is @logs, 3; is $logs[0]->{level}, 'debug'; is $logs[0]->{message}, 'This is debug'; is $logs[1]->{level}, 'info'; is $logs[1]->{message}, 'code ref'; is $logs[2]->{level}, 'notice'; is $logs[2]->{message}, 'stringified object'; }; done_testing; Plack-1.0039/t/Plack-Middleware/order.t000644 000765 000024 00000000607 12631015706 020456 0ustar00miyagawastaff000000 000000 use strict; use Plack::Builder; use Test::More; my $handler = builder { enable "Plack::Middleware::XFramework", framework => 'Dog'; enable "Plack::Middleware::StackTrace"; sub { die "Oops"; }; }; open my $io, ">", \my $err; my $res = $handler->({ 'psgi.errors' => $io }); is $res->[0], 500; my %hdrs = @{$res->[1]}; is $hdrs{'X-Framework'}, 'Dog'; done_testing; Plack-1.0039/t/Plack-Middleware/prefix.t000644 000765 000024 00000000564 12631015706 020642 0ustar00miyagawastaff000000 000000 use strict; use Plack::Builder; use Test::More; my $handler = builder { enable "XFramework", framework => 'Dog'; enable "Plack::Middleware::StackTrace"; sub { die "Oops"; }; }; open my $io, ">", \my $err; my $res = $handler->({ 'psgi.errors' => $io }); is $res->[0], 500; my %hdrs = @{$res->[1]}; is $hdrs{'X-Framework'}, 'Dog'; done_testing; Plack-1.0039/t/Plack-Middleware/psgibin.t000644 000765 000024 00000000562 12631015706 020776 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use HTTP::Request::Common; use Plack::App::PSGIBin; my $app = Plack::App::PSGIBin->new(root => "eg/dot-psgi")->to_app; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/Hello.psgi?name=foo"); is $res->code, 200; is $res->content, "Hello World"; }; done_testing; Plack-1.0039/t/Plack-Middleware/rearrange_headers.t000644 000765 000024 00000002026 12631015706 023001 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Builder; my $app = sub { return [ 200, [ 'Last-Modified' => 'Wed, 23 Sep 2009 13:36:33 GMT', 'Content-Type' => 'text/plain', 'ETag' => 'foo bar', ], [ 'Hello Foo' ] ]; }; { my $test = "Pre-test: test that header order is not changed by default."; # Don't use Plack::Test since it uses HTTP::Headers to reorder itself my $res = $app->({}); is_deeply $res->[1], [ 'Last-Modified' => 'Wed, 23 Sep 2009 13:36:33 GMT', 'Content-Type' => 'text/plain', 'ETag' => 'foo bar', ], $test; } { my $test = "Rearrange Middleware changes the header order"; $app = builder { enable "Plack::Middleware::RearrangeHeaders"; $app; }; # Don't use Plack::Test since it uses HTTP::Headers to reorder itself my $res = $app->({}); is_deeply $res->[1], [ 'ETag' => 'foo bar', 'Content-Type' => 'text/plain', 'Last-Modified' => 'Wed, 23 Sep 2009 13:36:33 GMT', ], $test; } done_testing; Plack-1.0039/t/Plack-Middleware/recursive/000755 000765 000024 00000000000 12631015706 021162 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Middleware/refresh-init.t000644 000765 000024 00000002167 12631015706 021745 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::Requires qw(Module::Refresh); use File::Spec; use File::Temp; use HTTP::Request::Common; use Plack::Middleware::Refresh; use Plack::Test; use Test::More; sub write_file($$){ my ( $path, $content ) = @_; open my $out, '>', $path or die "$path: $!"; print $out $content; } my $tmpdir = File::Temp::tempdir( CLEANUP => 1 ); my $pm_file = File::Spec->catfile($tmpdir, 'SomeModule.pm'); write_file $pm_file, qq/sub SomeModule::hello {'...'}; 1;\n/; # Load SomeModule unshift @INC, $tmpdir; require SomeModule; my $app = Plack::Middleware::Refresh->wrap(sub { [200, [ 'X-SomeModule' => SomeModule->hello ], ["OK\n"]] }, cooldown => 0 ); test_psgi $app, sub { my $cb = shift; # Change SomeModule before the server gets requests. sleep 1; write_file $pm_file, qq/sub SomeModule::hello {'Hi.'}; 1;\n/; my $res = $cb->(GET "/"); is $res->header('X-SomeModule'), 'Hi.'; # Change again. sleep 1; write_file $pm_file, qq/sub SomeModule::hello {'Good-bye.'}; 1;\n/; $res = $cb->(GET "/"); is $res->header('X-SomeModule'), 'Good-bye.'; }; done_testing; Plack-1.0039/t/Plack-Middleware/runtime.t000644 000765 000024 00000000664 12631015706 021031 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::More; use HTTP::Request::Common; plan skip_all => "Skipping on $^O platform" if $^O eq 'MSWin32'; use Plack::Builder; my $app = builder { enable "Runtime"; sub { sleep 1; return [200, ['Content-Type'=>'text/html'], ["Hello"]]; }; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); ok $res->header('X-Runtime') >= 0.5; }; done_testing; Plack-1.0039/t/Plack-Middleware/simple_content_filter.t000644 000765 000024 00000001034 12631015706 023726 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use Plack::Builder; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain', 'Content-Length' => 9 ], [ 'Hello ', 'Foo' ] ]; }; $app = builder { enable "ContentLength"; enable "SimpleContentFilter", filter => sub { s/Foo/FooBar/g; }; $app; }; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(HTTP::Request->new(GET => 'http://localhost/')); is $res->content, 'Hello FooBar'; is $res->content_length, 12; }; done_testing; Plack-1.0039/t/Plack-Middleware/simple_logger.t000644 000765 000024 00000001246 12631015706 022173 0ustar00miyagawastaff000000 000000 use strict; use Plack::Test; use Test::More; use Plack::Middleware::SimpleLogger; use HTTP::Request::Common; my $app = sub { my $env = shift; my $errors; $env->{'psgi.errors'} = do { open my $io, ">", \$errors; $io }; $env->{'psgix.logger'}->({ level => "debug", message => "This is debug" }); $env->{'psgix.logger'}->({ level => "info", message => "This is info" }); return [ 200, [], [$errors] ]; }; $app = Plack::Middleware::SimpleLogger->wrap($app, level => "info"); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); like $res->content, qr/This is info/; unlike $res->content, qr/This is debug/; }; done_testing; Plack-1.0039/t/Plack-Middleware/stacktrace/000755 000765 000024 00000000000 12631015706 021277 5ustar00miyagawastaff000000 000000 Plack-1.0039/t/Plack-Middleware/static.foo000644 000765 000024 00000000004 12631015706 021141 0ustar00miyagawastaff000000 000000 bar Plack-1.0039/t/Plack-Middleware/static.t000644 000765 000024 00000005401 12631015706 020627 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Middleware::Static; use Plack::Builder; use Plack::Util; use HTTP::Request::Common; use HTTP::Response; use Cwd; use Plack::Test; my $base = cwd; Plack::MIME->add_type(".foo" => "text/x-fooo"); my $handler = builder { enable "Plack::Middleware::Static", path => sub { s!^/share/!!}, root => "share"; enable "Plack::Middleware::Static", path => sub { s!^/more_share/!! if $_[1]->{PATH_INFO} =~ m!^/more_share/! }, root => "share"; enable "Plack::Middleware::Static", path => sub { s!^/share-pass/!!}, root => "share", pass_through => 1; enable "Plack::Middleware::Static", path => qr{\.(t|PL|txt)$}i, root => '.'; enable "Plack::Middleware::Static", path => qr{\.foo$}i, root => '.', content_type => sub { substr Plack::MIME->mime_type($_[0]),0,-1 } ; sub { [200, ['Content-Type' => 'text/plain', 'Content-Length' => 2], ['ok']] }; }; my %test = ( client => sub { my $cb = shift; { my $path = "t/test.txt"; my $res = $cb->(GET "http://localhost/$path"); is $res->content_type, 'text/plain', 'ok case'; like $res->content, qr/foo/; is -s $path, length($res->content); my $content = do { open my $fh, "<", $path; binmode $fh; join '', <$fh> }; is $content, $res->content; } { my $res = $cb->(GET "http://localhost/..%2f..%2f..%2fetc%2fpasswd.t"); is $res->code, 403; } { my $res = $cb->(GET "http://localhost/..%2fMakefile.PL"); is $res->code, 403, 'directory traversal'; } { my $res = $cb->(GET "http://localhost/foo/not_found.t"); is $res->code, 404, 'not found'; is $res->content, 'not found'; } { my $res = $cb->(GET "http://localhost/share/face.jpg"); is $res->content_type, 'image/jpeg'; } { my $res = $cb->(GET "http://localhost/more_share/face.jpg"); is $res->content_type, 'image/jpeg'; } { my $res = $cb->(GET "http://localhost/share-pass/faceX.jpg"); is $res->code, 200, 'pass through'; is $res->content, 'ok'; } { my $res = $cb->(GET "http://localhost/t/Plack-Middleware/static.txt"); is $res->content_type, 'text/plain'; my($ct, $charset) = $res->content_type; is $charset, 'charset=utf-8'; } { my $res = $cb->(GET "http://localhost/t/Plack-Middleware/static.foo"); is $res->content_type, 'text/x-foo'; } }, app => $handler, ); test_psgi %test; done_testing; Plack-1.0039/t/Plack-Middleware/static.txt000644 000765 000024 00000000004 12631015706 021175 0ustar00miyagawastaff000000 000000 foo Plack-1.0039/t/Plack-Middleware/static_env.t000644 000765 000024 00000001427 12631015706 021503 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::Test; use HTTP::Request::Common; use Plack::Middleware::AccessLog; use Plack::Middleware::Auth::Basic; use Plack::Middleware::Static; my $app = sub { my $env = shift; return [ 200, ['Content-Type' => 'text/plain'], ["Hello $env->{REMOTE_USER}"] ]; }; $app = Plack::Middleware::Static->wrap($app, path => qr!^/t/!, root => "."); $app = Plack::Middleware::Auth::Basic->wrap($app, authenticator => sub { 1 }); my $line; $app = Plack::Middleware::AccessLog->wrap($app, logger => sub { $line = shift }); test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/t/test.txt", Authorization => "Basic YWRtaW46czNjcjN0"); like $res->content, qr/foo/; like $line, qr/ admin /; }; done_testing; Plack-1.0039/t/Plack-Middleware/urlmap.t000644 000765 000024 00000003312 12631015706 020637 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::App::URLMap; use Plack::Test; use HTTP::Request::Common; my $make_app = sub { my $name = shift; sub { my $env = shift; my $body = join "|", $name, $env->{SCRIPT_NAME}, $env->{PATH_INFO}; return [ 200, [ 'Content-Type' => 'text/plain' ], [ $body ] ]; }; }; my $app1 = $make_app->("app1"); my $app2 = $make_app->("app2"); my $app3 = $make_app->("app3"); my $app4 = $make_app->("app4"); my $app = Plack::App::URLMap->new; $app->map("/" => $app1); $app->map("/foo" => $app2); $app->map("/foobar" => $app3); $app->map("http://bar.example.com/" => $app4); test_psgi app => $app, client => sub { my $cb = shift; my $res ; $res = $cb->(GET "http://localhost/"); is $res->content, 'app1||/'; $res = $cb->(GET "http://localhost/foo"); is $res->content, 'app2|/foo|'; $res = $cb->(GET "http://localhost/foo/bar"); is $res->content, 'app2|/foo|/bar'; $res = $cb->(GET "http://localhost/foox"); is $res->content, 'app1||/foox'; $res = $cb->(GET "http://localhost/foox/bar"); is $res->content, 'app1||/foox/bar'; $res = $cb->(GET "http://localhost/foobar"); is $res->content, 'app3|/foobar|'; $res = $cb->(GET "http://localhost/foobar/baz"); is $res->content, 'app3|/foobar|/baz'; $res = $cb->(GET "http://localhost/bar/foo"); is $res->content, 'app1||/bar/foo'; $res = $cb->(GET "http://bar.example.com/"); is $res->content, 'app4||/'; $res = $cb->(GET "http://bar.example.com/foo"); is $res->content, 'app4||/foo'; # Fix a bug where $location eq '' $_ = "bar"; /bar/; $res = $cb->(GET "http://localhost/"); is $res->content, 'app1||/'; }; done_testing; Plack-1.0039/t/Plack-Middleware/urlmap_builder.t000644 000765 000024 00000003037 12631015706 022351 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::App::URLMap; use Plack::Builder; use Plack::Test; use HTTP::Request::Common; my $make_app = sub { my $name = shift; sub { my $env = shift; my $body = join "|", $name, $env->{SCRIPT_NAME}, $env->{PATH_INFO}; return [ 200, [ 'Content-Type' => 'text/plain' ], [ $body ] ]; }; }; my $app1 = $make_app->("app1"); my $app2 = $make_app->("app2"); my $app3 = $make_app->("app3"); my $app4 = $make_app->("app4"); my $app = builder { mount "/" => $app1; mount "/foo" => builder { enable "Plack::Middleware::XFramework", framework => "Bar"; $app2; }; mount "/foobar" => builder { $app3 }; mount "http://bar.example.com/" => $app4; }; test_psgi app => $app, client => sub { my $cb = shift; my $res ; $res = $cb->(GET "http://localhost/"); is $res->content, 'app1||/'; $res = $cb->(GET "http://localhost/foo"); is $res->header('X-Framework'), 'Bar'; is $res->content, 'app2|/foo|'; $res = $cb->(GET "http://localhost/foo/bar"); is $res->content, 'app2|/foo|/bar'; $res = $cb->(GET "http://localhost/foox"); is $res->content, 'app1||/foox'; $res = $cb->(GET "http://localhost/foobar"); is $res->content, 'app3|/foobar|'; $res = $cb->(GET "http://localhost/foobar/baz"); is $res->content, 'app3|/foobar|/baz'; $res = $cb->(GET "http://bar.example.com/"); is $res->content, 'app4||/'; $res = $cb->(GET "http://bar.example.com/foo"); is $res->content, 'app4||/foo'; }; done_testing; Plack-1.0039/t/Plack-Middleware/urlmap_env.t000644 000765 000024 00000001403 12631015706 021506 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::App::URLMap; use Plack::Test; use HTTP::Request::Common; use Plack::Middleware::Auth::Basic; use Plack::Middleware::AccessLog; my $app1 = sub { my $env = shift; return [ 200, ['Content-Type' => 'text/plain'], ["Hello $env->{REMOTE_USER}"] ]; }; $app1 = Plack::Middleware::Auth::Basic->wrap($app1, authenticator => sub { 1 }); my $app = Plack::App::URLMap->new; $app->map("/foo" => $app1); my $line; $app = Plack::Middleware::AccessLog->wrap($app, logger => sub { $line = shift }); test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/foo", Authorization => "Basic YWRtaW46czNjcjN0"); is $res->content, 'Hello admin'; like $line, qr/ admin /; }; done_testing; Plack-1.0039/t/Plack-Middleware/urlmap_ports.t000644 000765 000024 00000001354 12631015706 022072 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Plack::App::URLMap; use Plack::Test; use HTTP::Request::Common; $Plack::Test::Impl = "Server"; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my $make_app = sub { my $name = shift; sub { my $env = shift; my $body = join "|", $name, $env->{SCRIPT_NAME}, $env->{PATH_INFO}; return [ 200, [ 'Content-Type' => 'text/plain' ], [ $body ] ]; }; }; my $app1 = $make_app->("app1"); my $app2 = $make_app->("app2"); my $app = Plack::App::URLMap->new; $app->map("http://127.0.0.1/" => $app1); $app->map("/" => $app2); test_psgi app => $app, client => sub { my $cb = shift; my $res; $res = $cb->(GET "http://127.0.0.1/"); is $res->content, 'app1||/'; }; done_testing; Plack-1.0039/t/Plack-Middleware/wrapcgi.t000644 000765 000024 00000001701 12631015706 020773 0ustar00miyagawastaff000000 000000 use strict; use Test::More; plan skip_all => "Hangs on Windows" if $^O eq 'MSWin32'; use Test::Requires { 'CGI::Emulate::PSGI' => 0.06, 'CGI::Compile' => 0.03 }; use Plack::Test; use HTTP::Request::Common; use Plack::App::WrapCGI; use IO::File; use File::Temp; my $app = Plack::App::WrapCGI->new(script => "t/Plack-Middleware/cgi-bin/hello.cgi")->to_app; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/?name=foo"); is $res->code, 200; is $res->content, "Hello foo counter=1"; $res = $cb->(GET "http://localhost/?name=bar"); is $res->code, 200; is $res->content, "Hello bar counter=2"; }; $app = Plack::App::WrapCGI->new( script => "t/Plack-Middleware/cgi-bin/cgi_dir.cgi", execute => 1)->to_app; test_psgi app => $app, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/?"); is $res->code, 200; is $res->content, "MATCH"; }; done_testing; Plack-1.0039/t/Plack-Middleware/wrapcgi_exec.t000644 000765 000024 00000007066 12631015706 022011 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Test::Requires { 'CGI::Emulate::PSGI' => 0.06, 'CGI::Compile' => 0.03 }; use Plack::Test; use HTTP::Request::Common; use Plack::App::WrapCGI; use IO::File; use File::Temp; plan skip_all => $^O if $^O eq "MSWin32"; { my $tmp = File::Temp->new(CLEANUP => 1); print $tmp <<"..."; #!$^X use CGI; my \$q = CGI->new; print \$q->header, "Hello ", scalar \$q->param('name'), " counter=", ++\$COUNTER; ... close $tmp; chmod(oct("0700"), $tmp->filename) or die "Cannot chmod"; my $app_exec = Plack::App::WrapCGI->new(script => "$tmp", execute => 1)->to_app; test_psgi app => $app_exec, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/?name=foo"); is $res->code, 200; is $res->content, "Hello foo counter=1"; $res = $cb->(POST "http://localhost/", ['name' => 'bar']); is $res->code, 200; is $res->content, "Hello bar counter=1"; }; undef $tmp; }; { my $tmp = File::Temp->new(CLEANUP => 1); print $tmp <<"..."; #!$^X use CGI; my \$q = CGI->new; print \$q->header, "Hello " x 10000; ... close $tmp; chmod(oct("0700"), $tmp->filename) or die "Cannot chmod"; my $app_exec = Plack::App::WrapCGI->new(script => "$tmp", execute => 1)->to_app; test_psgi app => $app_exec, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/"); is $res->code, 200; }; undef $tmp; } # test that wrapped cgi doesn't wait indefinitely for STDIN { my $tmp = File::Temp->new(CLEANUP => 1); print $tmp <<"..."; #!$^X print "Content-type: text/plain\\n\\nYou said: "; local \$/; print ; ... close $tmp; chmod(oct("0700"), $tmp->filename) or die "Cannot chmod"; my $app_exec = Plack::App::WrapCGI->new(script => "$tmp", execute => 1)->to_app; test_psgi app => $app_exec, client => sub { my $cb = shift; eval { # without the fix $res->content seems to be "alarm\n" which still fails local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required alarm(10); my $res = $cb->(GET "http://localhost/?name=foo"); alarm(0); is $res->code, 200; is $res->content, "You said: "; alarm(10); $res = $cb->(POST "http://localhost/", Content => "doing things\nthe hard way"); alarm(0); is $res->code, 200; is $res->content, "You said: doing things\nthe hard way"; }; if ( $@ ) { die unless $@ eq "alarm\n"; # propagate unexpected errors ok 0, "request timed out waiting for STDIN"; } }; undef $tmp; }; # test that current directory is same the script directory { my $tmp = File::Temp->new(CLEANUP => 1); print $tmp <<"..."; #!$^X use CGI; use File::Basename qw/dirname/; use Cwd; my \$cgi_dir = Cwd::abs_path( dirname( __FILE__ ) ); my \$exec_dir = Cwd::abs_path( Cwd::getcwd ); my \$result = \$cgi_dir eq \$exec_dir ? "MATCH" : "DIFFERENT"; if (\$result ne "MATCH") { \$result .= "\nCGI_DIR: \$cgi_dir\nEXEC_DIR: \$exec_dir\n"; } my \$q = CGI->new; print \$q->header(-type => "text/plain"), \$result; ... close $tmp; chmod(oct("0700"), $tmp->filename) or die "Cannot chmod"; my $app_exec = Plack::App::WrapCGI->new(script => "$tmp", execute => 1)->to_app; test_psgi app => $app_exec, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/?"); is $res->code, 200; is $res->content, "MATCH"; }; undef $tmp; }; done_testing; Plack-1.0039/t/Plack-Middleware/xframework.t000644 000765 000024 00000000462 12631015706 021527 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Plack::Builder; use Test::More; my $handler = builder { enable "Plack::Middleware::XFramework", framework => 'Dog'; sub { [200, [], ['ok']] }; }; my $res = $handler->(+{}); is_deeply $res, [200, ['X-Framework' => 'Dog'], ['ok']]; done_testing; Plack-1.0039/t/Plack-Middleware/xsendfile.t000644 000765 000024 00000002012 12631015706 021314 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common; use Plack::Builder; use Plack::Test; use Cwd; sub is_wo_case($$;$) { is lc $_[0], lc $_[1], $_[2]; } my $handler = builder { enable "Plack::Middleware::XSendfile"; enable "Plack::Middleware::Static", path => qr/./, root => "."; sub { }; }; test_psgi app => $handler, client => sub { my $cb = shift; { my $req = GET "http://localhost/t/test.txt", 'X-Sendfile-Type' => 'X-Sendfile'; my $res = $cb->($req); is $res->content_type, 'text/plain';; is_wo_case $res->header('X-Sendfile'), Cwd::realpath("t/test.txt"); # wo_case for Win32-- is $res->content, ''; } }; test_psgi( app => sub { return [ 200, [ 'X-Sendfile' => '/foo/bar.txt' ], [] ] }, client => sub { my $cb = shift; my $res = $cb->(GET "http://localhost/foo", 'X-Sendfile-Type' => 'X-Sendfile'); is $res->header('X-Sendfile'), '/foo/bar.txt', 'pass through app header'; }, ); done_testing; Plack-1.0039/t/Plack-Middleware/stacktrace/basic.t000644 000765 000024 00000001655 12631015706 022554 0ustar00miyagawastaff000000 000000 use strict; use warnings; use Test::More; use Plack::Middleware::StackTrace; use Plack::Test; use HTTP::Request::Common; my $traceapp = Plack::Middleware::StackTrace->wrap(sub { die "orz" }, no_print_errors => 1); my $app = sub { my $env = shift; my $ret = $traceapp->($env); like $env->{'plack.stacktrace.text'}, qr/orz/; return $ret; }; my @backends = ($Plack::Middleware::StackTrace::StackTraceClass); push @backends, "Devel::StackTrace" if $backends[0] eq 'Devel::StackTrace::WithLexicals'; for my $be (@backends) { local $Plack::Middleware::StackTrace::StackTraceClass = $be; test_psgi $app, sub { my $cb = shift; my $req = GET "/"; $req->header(Accept => "text/html,*/*"); my $res = $cb->($req); ok $res->is_error; is_deeply [ $res->content_type ], [ 'text/html', 'charset=utf-8' ]; like $res->content, qr/Error: orz/; } } done_testing; �����������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/stacktrace/force.t��������������������������������������������������000644 �000765 �000024 �00000001376 12631015706 022571� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Middleware::StackTrace; use Plack::Test; use HTTP::Request::Common; my $app = sub { eval { die "Blah" }; return [ 500, [ 'Content-Type', 'text/html' ], [ "Fancy Error" ] ]; }; my $default_app = Plack::Middleware::StackTrace->wrap($app, no_print_errors => 1); test_psgi $default_app, sub { my $cb = shift; my $req = GET "/"; my $res = $cb->($req); is $res->code, 500; like $res->content, qr/Fancy Error/; }; my $force_app = Plack::Middleware::StackTrace->wrap($app, force => 1, no_print_errors => 1); test_psgi $force_app, sub { my $cb = shift; my $req = GET "/"; my $res = $cb->($req); is $res->code, 500; like $res->content, qr/Blah/; }; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/stacktrace/multiple_exceptions.t������������������������������������000644 �000765 �000024 �00000005451 12631015706 025565� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Middleware::StackTrace; use Plack::Test; use HTTP::Request::Common; { # Simple exception object package Plack::Middleware::StackTrace::Exception; use overload '""' => sub { $_[0]->{message} }; sub new { my ($class, $message) = @_; return bless { message => $message }, $class; } } # Tracks how often the destructor was called my $dtor_count; { # A class similar to DBIx::Class::Storage::TxnScopeGuard where the # destructor might throw and catch another exception. package Plack::Middleware::StackTrace::Guard; use Try::Tiny; sub new { my ($class, $exception) = @_; return bless { exception => $exception }, $class; } sub DESTROY { my $self = shift; ++$dtor_count; try { die $self->{exception}; }; } } sub test_dtor_exception { my ($orig_exception, $dtor_exception) = @_; my $dtor_exception_app = sub { my $guard = Plack::Middleware::StackTrace::Guard->new($dtor_exception); die $orig_exception; }; my $trace_app = Plack::Middleware::StackTrace->wrap($dtor_exception_app, no_print_errors => 1, ); test_psgi $trace_app, sub { my $cb = shift; $dtor_count = 0; my $req = GET "/"; my $res = $cb->($req); is $res->code, 500, "Status code is 500"; like $res->content, qr/^\Q$orig_exception\E at /, "Original exception returned"; is $dtor_count, 1, "Destructor called only once"; }; } test_dtor_exception("urz", "orz"); test_dtor_exception( Plack::Middleware::StackTrace::Exception->new("urz"), Plack::Middleware::StackTrace::Exception->new("orz"), ); { # A middleware that rethrows exceptions package Plack::Middleware::StackTrace::Rethrow; use parent qw(Plack::Middleware); use Try::Tiny; sub call { my ($self, $env) = @_; try { $self->app->($env); } catch { die $_; }; } } # This sub is expected to appear in the stack trace. sub fizzle { my $exception = shift; die $exception; } sub test_rethrown_exception { my $exception = shift; my $die_app = sub { fizzle($exception); }; my $rethrow_app = Plack::Middleware::StackTrace::Rethrow->wrap($die_app); my $trace_app = Plack::Middleware::StackTrace->wrap($rethrow_app, no_print_errors => 1, ); test_psgi $trace_app, sub { my $cb = shift; my $req = GET "/"; my $res = $cb->($req); is $res->code, 500, "Status code is 500"; like $res->content, qr/\bfizzle\b/, "Original stack trace returned"; }; } test_rethrown_exception("orz"); test_rethrown_exception(Plack::Middleware::StackTrace::Exception->new("orz")); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/stacktrace/sigdie.t�������������������������������������������������000644 �000765 �000024 �00000001033 12631015706 022725� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Middleware::StackTrace; use Plack::Test; use HTTP::Request::Common; $Plack::Test::Impl = "Server"; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my $app = sub { $SIG{__DIE__} = sub {}; die "meh"; }; my $wrapped = Plack::Middleware::StackTrace->wrap($app, no_print_errors => 1); test_psgi $wrapped, sub { my $cb = shift; my $req = GET "/"; my $res = $cb->($req); is $res->code, 500; like $res->content, qr/The application raised/; }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/stacktrace/streaming.t����������������������������������������������000644 �000765 �000024 �00000001031 12631015706 023450� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Middleware::StackTrace; use Plack::Test; use HTTP::Request::Common; my $app = sub { eval { require DooBar }; return sub { my $respond = shift; $respond->([ 200, [ "Content-Type", "text/plain" ], [ "Hello World" ] ]); }; }; $app = Plack::Middleware::StackTrace->wrap($app); test_psgi $app, sub { my $cb = shift; my $req = GET "/"; my $res = $cb->($req); ok $res->is_success; like $res->content, qr/Hello World/; }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/stacktrace/utf8.t���������������������������������������������������000644 �000765 �000024 �00000001227 12631015706 022354� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Test::Requires { 'Devel::StackTrace::AsHTML' => 0.08 }; use Plack::Middleware::StackTrace; use Plack::Test; use HTTP::Request::Common; $Plack::Test::Impl = "Server"; local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI"; my $app = Plack::Middleware::StackTrace->wrap(sub { die "Foo \x{30c6}" }, no_print_errors => 1); test_psgi $app, sub { my $cb = shift; my $req = GET "/"; $req->header(Accept => "text/html,*/*"); my $res = $cb->($req); like $res->content, qr/Foo テ/; $req = GET "/"; $res = $cb->($req); is $res->code, 500; like $res->content, qr/Foo/; }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/recursive/base.t����������������������������������������������������000644 �000765 �000024 �00000001171 12631015706 022261� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Plack::Test; use HTTP::Request::Common; use Plack::Middleware::Recursive; my $app = sub { my $env = shift; if ($env->{PATH_INFO} eq '/forwarded') { is_deeply $env->{'plack.recursive.old_path_info'}, [ '/' ]; return [ 200, [ 'Content-Type', 'text/plain' ], [ "Hello $env->{QUERY_STRING}" ] ]; } return $env->{'plack.recursive.include'}->("/forwarded?q=bar"); }; $app = Plack::Middleware::Recursive->wrap($app); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200; is $res->content, "Hello q=bar"; }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/recursive/streaming.t�����������������������������������������������000644 �000765 �000024 �00000001377 12631015706 023350� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Plack::Test; use HTTP::Request::Common; use Plack::Middleware::Recursive; my $app = sub { my $env = shift; if ($env->{PATH_INFO} eq '/forwarded') { is_deeply $env->{'plack.recursive.old_path_info'}, [ '/' ]; return sub { $_[0]->([ 200, [ 'Content-Type', 'text/plain' ], [ "Hello $env->{QUERY_STRING}" ] ]) }; } return sub { my $respond = shift; my $r = $env->{'plack.recursive.include'}->("/forwarded?q=bar"); ref $r eq 'CODE' ? $r->($respond) : $respond->($r); }; }; $app = Plack::Middleware::Recursive->wrap($app); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200; is $res->content, "Hello q=bar"; }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/recursive/throw.t���������������������������������������������������000644 �000765 �000024 �00000001627 12631015706 022520� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Plack::Test; use HTTP::Request::Common; use Plack::Middleware::Recursive; my $app = sub { my $env = shift; if ($env->{PATH_INFO} eq '/forwarded2') { is_deeply $env->{'plack.recursive.old_path_info'}, [ '/', '/forwarded' ]; return [ 200, [ 'Content-Type', 'text/plain' ], [ "Hello $env->{QUERY_STRING}" ] ]; } elsif ($env->{PATH_INFO} eq '/forwarded') { Plack::Recursive::ForwardRequest->throw("/forwarded2?q=bar"); } elsif ($env->{PATH_INFO} eq '/die') { die "Foo"; } Plack::Recursive::ForwardRequest->throw("/forwarded?q=bar"); }; $app = Plack::Middleware::Recursive->wrap($app); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200; is $res->content, "Hello q=bar"; $res = $cb->(GET "/die"); is $res->code, 500; like $res->content, qr/Foo at /; }; done_testing; ���������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/recursive/throw_streaming.t�����������������������������������������000644 �000765 �000024 �00000001500 12631015706 024557� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Plack::Test; use HTTP::Request::Common; use Plack::Middleware::Recursive; my $app = sub { my $env = shift; if ($env->{PATH_INFO} eq '/forwarded2') { is_deeply $env->{'plack.recursive.old_path_info'}, [ '/', '/forwarded' ]; return sub { $_[0]->([ 200, [ 'Content-Type', 'text/plain' ], [ "Hello $env->{QUERY_STRING}" ] ]) }; } elsif ($env->{PATH_INFO} eq '/forwarded') { Plack::Recursive::ForwardRequest->throw("/forwarded2?q=bar"); } return sub { my $respond = shift; Plack::Recursive::ForwardRequest->throw("/forwarded"); }; }; $app = Plack::Middleware::Recursive->wrap($app); test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->code, 200; is $res->content, "Hello q=bar"; }; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/errors/404.html�����������������������������������������������������000644 �000765 �000024 �00000000041 12631015706 021657� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������a b c This is a fancy 404 page. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/errors/500.html�����������������������������������������������������000644 �000765 �000024 �00000000032 12631015706 021654� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������This is a fancy 500 page! ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cgi-bin/cgi_dir.cgi�������������������������������������������������000755 �000765 �000024 �00000000545 12631015706 022556� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/env perl use File::Basename qw/dirname/; use Cwd; my $cgi_dir = Cwd::abs_path( dirname( __FILE__ ) ); my $exec_dir = Cwd::abs_path( Cwd::getcwd ); my $result = $cgi_dir eq $exec_dir ? "MATCH" : "DIFFERENT"; if ($result ne "MATCH") { $result .= "\nCGI_DIR: $cgi_dir\nEXEC_DIR: $exec_dir\n"; } print "Content-Type: text/plain\n\n", $result; �����������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cgi-bin/hello.cgi���������������������������������������������������000755 �000765 �000024 �00000000172 12631015706 022255� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use CGI; my $q = CGI->new; print $q->header, "Hello ", scalar $q->param('name'), " counter=", ++$COUNTER; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cgi-bin/hello.py����������������������������������������������������000755 �000765 �000024 �00000000274 12631015706 022146� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/python import os print "Content-Type: text/plain" print for item in ([ "foo", "bar" ]): print "Hello " + item + ". " print "QUERY_STRING is " + os.environ['QUERY_STRING'] ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cgi-bin/hello2.cgi��������������������������������������������������000755 �000765 �000024 �00000000172 12631015706 022337� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use CGI; my $q = CGI->new; print $q->header, "Hello ", scalar $q->param('name'), " counter=", ++$COUNTER; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cgi-bin/hello3.cgi��������������������������������������������������000755 �000765 �000024 �00000000150 12631015706 022334� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use Data::Dumper; print "Content-Type: text/plain\r\n\r\n"; print 'my ' . Dumper \%ENV; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cgi-bin/utf8.cgi����������������������������������������������������000755 �000765 �000024 �00000000152 12631015706 022036� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl use CGI; binmode STDOUT, ":utf8"; print CGI::header("text/html;charset=utf-8"), chr(4343), "\n"; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cascade/basic.t�����������������������������������������������������000644 �000765 �000024 �00000001457 12631015706 022013� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Plack::Test; use Test::More; use Plack::App::Cascade; use Plack::App::File; use HTTP::Request::Common; my $cascade = Plack::App::Cascade->new; test_psgi $cascade, sub { my $cb = shift; $res = $cb->(GET "http://localhost/"); is $res->code, 404; }; $cascade->add( Plack::App::File->new(root => "t/Plack-Middleware")->to_app ); $cascade->add( Plack::App::File->new(root => "t/Plack-Util")->to_app ); $cascade->add( sub { [ 404, [], [ 'Custom 404 Page' ] ] } ); test_psgi $cascade, sub { my $cb = shift; my $res = $cb->(GET "http://localhost/access_log.t"); is $res->code, 200; $res = $cb->(GET "http://localhost/foo"); is $res->code, 404; is $res->content, 'Custom 404 Page'; $res = $cb->(GET "http://localhost/foreach.t"); is $res->code, 200; }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Middleware/cascade/streaming.t�������������������������������������������������000644 �000765 �000024 �00000002210 12631015706 022707� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Plack::Test; use Test::More; use Plack::App::Cascade; use HTTP::Request::Common; my $cascade = Plack::App::Cascade->new; $cascade->add( sub { return sub { my $respond = shift; $respond->([ 404, [], [ "Duh" ] ]) } } ); $cascade->add( sub { return [ 403, [ 'Content-Type', 'text/plain' ], [ "Forbidden" ] ] } ); $cascade->add( sub { my $env = shift; return sub { my $r = shift; if ($env->{PATH_INFO} eq '/') { my $w = $r->([ 200, [ 'Content-Type', 'text/plain' ] ]); $w->write("Hello"); $w->close; } else { $r->([ 404, [ 'Content-Type', 'text/plain' ], [ 'Custom 404 Page' ] ]); } } }); $cascade->catch([ 403, 404 ]); test_psgi $cascade, sub { my $cb = shift; my $res = $cb->(GET "http://localhost/"); is $res->code, 200; is $res->content, "Hello"; $res = $cb->(GET "http://localhost/xyz"); is $res->code, 404; is $res->content, 'Custom 404 Page'; }; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Loader/auto.t������������������������������������������������������������������000644 �000765 �000024 �00000001012 12631015706 017433� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Loader; my $builder = sub { require AnyEvent; my $app = sub { return [ 200, [], [ "Hi" ] ]; }; }; $INC{"Plack/Handler/Twiggy.pm"} = __FILE__; sub Plack::Handler::Twiggy::new { bless {}, shift } no warnings 'redefine'; local *Plack::Loader::env = sub { return {} }; eval { my $loader = Plack::Loader->new; $loader->preload_app($builder); my $server = $loader->auto; like ref $server, qr/Twiggy/; }; ok 1 if $@; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Loader/auto_fallback.t���������������������������������������������������������000644 �000765 �000024 �00000000644 12631015706 021264� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; no warnings 'redefine'; use Test::More; use Plack::Loader; my $builder = sub { my $app = sub { return [ 200, [], [ "Hi" ] ]; }; }; local *Plack::Loader::guess = sub { 'NonExistent' }; local $SIG{__WARN__} = sub { like $_[0], qr/Autoloading/ }; my $loader = Plack::Loader->new; $loader->preload_app($builder); my $server = $loader->auto; like ref $server, qr/Standalone/; done_testing; ��������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Loader/delayed.t���������������������������������������������������������������000644 �000765 �000024 �00000000660 12631015706 020102� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Plack::Loader; my $compiled; my $builder = sub { $compiled = 1; my $app = sub { return [ 200, [], [ "Hi" ] ]; }; }; # The following eval might not fail if you set PLACK_SEVER delete $ENV{PLACK_SERVER}; eval { my $loader = Plack::Loader::Delayed->new; $loader->preload_app($builder); my $server = $loader->auto; ok(!$compiled); }; ok 1 if $@; done_testing; ��������������������������������������������������������������������������������Plack-1.0039/t/Plack-Loader/restarter.t�������������������������������������������������������������000644 �000765 �000024 �00000003210 12631015706 020500� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Test::TCP; use Test::Requires qw(LWP::UserAgent); use HTTP::Request::Common; use Plack::Loader::Restarter; plan skip_all => "author test only" unless $ENV{AUTHOR_TESTING}; $SIG{__WARN__} = sub { diag @_ }; my @return_bodies = ('Hi first', 'Hi second', 'Hi third'); my @restartertestfiles = ('t/restartertestfile1.pl', 't/restartertestfile2.pl'); unlink $_ for @restartertestfiles; my $builder = sub { my $idx = 0; for my $file (@restartertestfiles) { $idx++ if -e $file; } my $return_body = $return_bodies[$idx]; my $app = sub { return [ 200, [], [ $return_body ] ]; }; }; test_tcp( client => sub { my $port = shift; my $ua = LWP::UserAgent->new; my $cb = sub { my $req = HTTP::Request->new(GET => sprintf('http://127.0.0.1:%s/', $port)); return $ua->request($req); }; is $cb->()->content, $return_bodies[0]; touch($restartertestfiles[0]); sleep 2; wait_port($port); is $cb->()->content, $return_bodies[1]; touch($restartertestfiles[1]); sleep 2; wait_port($port); is $cb->()->content, $return_bodies[2]; }, server => sub { my $port = shift; my $loader = Plack::Loader::Restarter->new; my $server = $loader->auto(port => $port, host => '127.0.0.1'); $loader->preload_app($builder); $loader->watch('t'); $loader->run($server); }, ); sub touch { my $file = shift; open my $fh, ">", $file or die $!; print $fh time; close $fh; } unlink $_ for @restartertestfiles; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Loader/restarter_valid.t�������������������������������������������������������000644 �000765 �000024 �00000001146 12631015706 021665� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Plack::Loader::Restarter; use Test::More; my $r = Plack::Loader::Restarter->new; my @match = qw( Foo.pm foo.t lib/Bar.pm view/index.tt _myapp/foo.psgi .www/bar.pl _sass.css /Users/joe/foo/bar.pm /path/to/4912 /path/to/5037 ); my @ignore = qw( .git/123 .svn/abc Foo.pm~ _flymake.pl /Users/joe/foo.pl~ /foo/bar/x.txt.bak /path/to/foo.swp /path/to/foo.swpx /path/to/foo.swx /path/to/4913 /path/to/5036 /path/to/.#Foo.pm ); ok $r->valid_file({ path => $_ }), "$_ is valid" for @match; ok !$r->valid_file({ path => $_ }), "$_ should be ignored" for @ignore; done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Loader/shotgun.t���������������������������������������������������������������000644 �000765 �000024 �00000000727 12631015706 020166� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Test::Suite; plan skip_all => "Skip on Win32" if $^O eq 'MSWin32'; require Plack::Loader::Shotgun; Plack::Test::Suite->run_server_tests( sub { my($port, $app) = @_; my $loader = Plack::Loader::Shotgun->new; $loader->preload_app(sub { $app }); my $server = $loader->load('Standalone', port => $port, host => '127.0.0.1'); $loader->run($server); }, ); done_testing(); �����������������������������������������Plack-1.0039/t/Plack-HTTPParser-PP/simple.t���������������������������������������������������������000644 �000765 �000024 �00000005322 12631015706 021027� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use Plack::HTTPParser::PP; *parse_http_request = \&Plack::HTTPParser::PP::parse_http_request; my $req; my %env; $req = "GET /abc?x=y HTTP/1.0\r\n\r\n"; %env = (); is(parse_http_request($req, \%env), length($req), 'simple get'); is_deeply(\%env, { PATH_INFO => '/abc', QUERY_STRING => 'x=y', REQUEST_METHOD => "GET", SCRIPT_NAME => '', SERVER_PROTOCOL => 'HTTP/1.0', REQUEST_URI => '/abc?x=y', }, 'result of GET /'); $req = <<"EOT"; POST /hoge HTTP/1.1\r Content-Type: text/plain\r Content-Length: 15\r Host: example.com\r User-Agent: hoge\r \r EOT %env = (); is(parse_http_request($req, \%env), length($req), 'POST'); is_deeply(\%env, { CONTENT_LENGTH => 15, CONTENT_TYPE => 'text/plain', HTTP_HOST => 'example.com', HTTP_USER_AGENT => 'hoge', PATH_INFO => '/hoge', REQUEST_METHOD => "POST", REQUEST_URI => '/hoge', QUERY_STRING => '', SERVER_PROTOCOL => 'HTTP/1.1', SCRIPT_NAME => '', }, 'result of GET with headers'); $req = <<"EOT"; GET / HTTP/1.0\r Foo: \r Foo: \r abc\r de\r Foo: fgh\r \r EOT %env = (); is(parse_http_request($req, \%env), length($req), 'multiline header'); is_deeply(\%env, { HTTP_FOO => ', abc de, fgh', PATH_INFO => '/', QUERY_STRING => '', REQUEST_METHOD => 'GET', REQUEST_URI => '/', SCRIPT_NAME => '', SERVER_PROTOCOL => 'HTTP/1.0', }, 'multiline'); # dumb HTTP client: https://github.com/plack/Plack/issues/213 $req = <<"EOT"; GET /a/b#c HTTP/1.0\r \r EOT %env = (); is(parse_http_request($req, \%env), length($req), 'URI fragment'); is_deeply(\%env, { SCRIPT_NAME => '', PATH_INFO => '/a/b', REQUEST_METHOD => 'GET', REQUEST_URI => '/a/b#c', QUERY_STRING => '', SCRIPT_NAME => '', SERVER_PROTOCOL => 'HTTP/1.0', }); $req = <<"EOT"; GET /a/b%23c HTTP/1.0\r \r EOT %env = (); is(parse_http_request($req, \%env), length($req), '%23 -> #'); is_deeply(\%env, { SCRIPT_NAME => '', PATH_INFO => '/a/b#c', REQUEST_METHOD => 'GET', REQUEST_URI => '/a/b%23c', QUERY_STRING => '', SCRIPT_NAME => '', SERVER_PROTOCOL => 'HTTP/1.0', }); $req = <<"EOT"; GET /a/b?c=d#e HTTP/1.0\r \r EOT %env = (); is(parse_http_request($req, \%env), length($req), 'URI fragment after query string'); is_deeply(\%env, { SCRIPT_NAME => '', PATH_INFO => '/a/b', REQUEST_METHOD => 'GET', REQUEST_URI => '/a/b?c=d#e', QUERY_STRING => 'c=d', SCRIPT_NAME => '', SERVER_PROTOCOL => 'HTTP/1.0', }); my $w; { local $SIG{__WARN__} = sub { $w = shift }; $req = "GET /foo HTTP/1.0\r\n\r\n"; parse_http_request($req, \%env); } ok !$w; done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/apache1.t��������������������������������������������������������������000644 �000765 �000024 �00000003342 12631015706 020144� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack; use Test::TCP; use Test::Requires qw(LWP::UserAgent); use FindBin; use File::Path; use Plack::Test::Suite; plan skip_all => "TEST_APACHE1 is not set" unless $ENV{TEST_APACHE1}; Plack::Test::Suite->run_server_tests(\&run_httpd); done_testing(); my $log_filename; sub run_httpd { my $port = shift; my $tmpdir = $ENV{APACHE1_TMP_DIR} || File::Temp::tempdir( CLEANUP => 1 ); my $httpd = $ENV{APACHE_BIN} || 'httpd'; write_file("$tmpdir/app.psgi", _render_psgi()); write_file("$tmpdir/httpd.conf", _render_conf($tmpdir, $port, "$tmpdir/app.psgi")); mkpath( "$tmpdir/conf" ); write_file("$tmpdir/conf/mime.types", _render_mimetypes()); $log_filename = "$tmpdir/error_log"; system ("touch $log_filename"); link($log_filename, 'err'); exec "$httpd -X -F -f $tmpdir/httpd.conf" or die "couldn't start httpd : $!\n"; } sub write_file { my($path, $content) = @_; open my $out, ">", $path or die "$path: $!"; print $out $content; } sub _render_mimetypes { return 'text/html html htm'; } sub _render_psgi { return <<'EOF'; use lib "lib"; use Plack::Test::Suite; Plack::Test::Suite->test_app_handler; EOF } sub _render_conf { my ($tmpdir, $port, $psgi_path) = @_; my $load_module = ( -f "$tmpdir/libexec/mod_perl.so" ) ? 'LoadModule perl_module libexec/mod_perl.so' : '' ; my $conf = <<"END"; $load_module ServerRoot $tmpdir ServerName 127.0.0.1 PidFile $tmpdir/httpd.pid LockFile $tmpdir/httpd.lock ErrorLog $tmpdir/error_log Listen $port <Location /> SetHandler perl-script PerlHandler Plack::Handler::Apache1 PerlSetVar psgi_app $tmpdir/app.psgi </Location> END return $conf; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/apache2-registry.t�����������������������������������������������������000644 �000765 �000024 �00000005231 12631015706 022012� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use File::Path; use Test::TCP; use Test::Requires qw(LWP::UserAgent); use HTTP::Request::Common; use Test::More; plan skip_all => "TEST_APACHE2 is not set" unless $ENV{TEST_APACHE2}; # Note: you need to load 64bit lib to test Apache2 on OS X 10.5 or later test_tcp( client => sub { my $port = shift; my $ua = LWP::UserAgent->new; my $call = sub { my $req = shift; $req->uri->port($port); return $ua->request($req); }; my $res1 = $call->( GET 'http://127.0.0.1/psgi-bin/app.psgi' ); note $res1->content; is $res1->header('X-Script-Name'), '/psgi-bin/app.psgi'; is $res1->header('X-Path-Info') , ''; my $res2 = $call->( GET 'http://127.0.0.1/psgi-bin/deep/app.psgi/deeply' ); note $res2->content; is $res2->header('X-Script-Name'), '/psgi-bin/deep/app.psgi'; is $res2->header('X-Path-Info') , '/deeply'; my $res3 = $call->( GET 'http://127.0.0.1/psgi-bin/404.psgi' ); note $res3->content; is $res3->code, 404; my $res4 = $call->( GET 'http://127.0.0.1/psgi-bin/dead.psgi' ); note $res4->content; is $res4->code, 500; }, server => sub { my $port = shift; run_httpd($port); }, ); done_testing(); sub run_httpd { my $port = shift; my $tmpdir = $ENV{APACHE2_TMP_DIR} || File::Temp::tempdir( CLEANUP => 1 ); mkpath( "$tmpdir/psgi-bin" ); write_file("$tmpdir/psgi-bin/app.psgi", _render_psgi()); mkpath( "$tmpdir/psgi-bin/deep" ); write_file("$tmpdir/psgi-bin/deep/app.psgi", _render_psgi()); write_file("$tmpdir/psgi-bin/dead.psgi", _render_dead_psgi()); write_file("$tmpdir/httpd.conf", _render_conf($tmpdir, $port)); exec "httpd -X -D FOREGROUND -f $tmpdir/httpd.conf"; } sub write_file { my($path, $content) = @_; open my $out, ">", $path or die "$path: $!"; print $out $content; } sub _render_psgi { return <<'EOF'; sub { my $env = shift; [200, [ 'Content-Type' => 'text/plain', 'X-Script-Name' => $env->{SCRIPT_NAME}, 'X-Path-Info' => $env->{PATH_INFO}, ], ['OK']] } EOF } sub _render_dead_psgi { return <<'EOF'; die 'What's happen?'; EOF } sub _render_conf { my ($tmpdir, $port) = @_; <<"END"; LoadModule perl_module libexec/apache2/mod_perl.so ServerRoot $tmpdir DocumentRoot $tmpdir PidFile $tmpdir/httpd.pid LockFile $tmpdir/httpd.lock ErrorLog $tmpdir/error_log Listen $port PerlModule Plack::Handler::Apache2::Registry; <Location /psgi-bin> SetHandler modperl PerlHandler Plack::Handler::Apache2::Registry </Location> END } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/apache2.t��������������������������������������������������������������000644 �000765 �000024 �00000005514 12631015706 020150� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack; use Test::TCP; use Test::Requires qw(LWP::UserAgent); use FindBin; use Plack::Test::Suite; plan skip_all => "TEST_APACHE2 is not set" unless $ENV{TEST_APACHE2}; # Note: you need to load 64bit lib to test Apache2 on OS X 10.5 or later Plack::Test::Suite->run_server_tests(run_httpd(\&_render_conf)); local $ENV{PLACK_TEST_SCRIPT_NAME} = '/foo/bar/baz'; Plack::Test::Suite->run_server_tests( run_httpd(\&_render_conf_location),); Plack::Test::Suite->run_server_tests( run_httpd(\&_render_conf_location_match),); done_testing(); sub run_httpd { my $render_conf = shift; sub { my $port = shift; my $tmpdir = $ENV{APACHE2_TMP_DIR} || File::Temp::tempdir( CLEANUP => 1 ); write_file("$tmpdir/app.psgi", _render_psgi()); write_file("$tmpdir/httpd.conf", $render_conf->($tmpdir, $port, "$tmpdir/app.psgi")); # This is required for failing tests. # Apache2 peep real filesystem to make SCRIPT_NAME and PATH_INFO. mkdir "$tmpdir/foo"; exec "httpd -X -D FOREGROUND -f $tmpdir/httpd.conf"; }; } sub write_file { my($path, $content) = @_; open my $out, ">", $path or die "$path: $!"; print $out $content; } sub _render_psgi { return <<'EOF'; use lib "lib"; use Plack::Test::Suite; Plack::Test::Suite->test_app_handler; EOF } sub _render_conf { my ($tmpdir, $port, $psgi_path) = @_; <<"END"; LoadModule perl_module libexec/apache2/mod_perl.so ServerRoot $tmpdir DocumentRoot $tmpdir PidFile $tmpdir/httpd.pid LockFile $tmpdir/httpd.lock ErrorLog $tmpdir/error_log Listen $port <Perl> use Plack::Handler::Apache2; Plack::Handler::Apache2->preload("$tmpdir/app.psgi"); </Perl> <Location /> SetHandler perl-script PerlHandler Plack::Handler::Apache2 PerlSetVar psgi_app $tmpdir/app.psgi </Location> END } sub _render_conf_location { my ($tmpdir, $port, $psgi_path) = @_; <<"END"; LoadModule perl_module libexec/apache2/mod_perl.so ServerRoot $tmpdir DocumentRoot $tmpdir PidFile $tmpdir/httpd.pid LockFile $tmpdir/httpd.lock ErrorLog $tmpdir/error_log Listen $port <Perl> use Plack::Handler::Apache2; Plack::Handler::Apache2->preload("$tmpdir/app.psgi"); </Perl> <Location /foo/bar/baz> SetHandler perl-script PerlHandler Plack::Handler::Apache2 PerlSetVar psgi_app $tmpdir/app.psgi </Location> END } sub _render_conf_location_match { my ($tmpdir, $port, $psgi_path) = @_; <<"END"; LoadModule perl_module libexec/apache2/mod_perl.so ServerRoot $tmpdir DocumentRoot $tmpdir PidFile $tmpdir/httpd.pid LockFile $tmpdir/httpd.lock ErrorLog $tmpdir/error_log Listen $port <Perl> use Plack::Handler::Apache2; Plack::Handler::Apache2->preload("$tmpdir/app.psgi"); </Perl> <LocationMatch /foo/bar/(baz)> SetHandler perl-script PerlHandler Plack::Handler::Apache2 PerlSetVar psgi_app $tmpdir/app.psgi </LocationMatch> END } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/cgi.t������������������������������������������������������������������000644 �000765 �000024 �00000002030 12631015706 017375� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::Requires { 'HTTP::Request::AsCGI' => 1.2, }; use Test::More; use FindBin; use HTTP::Request::AsCGI; use URI::Escape; use Plack; use Plack::Handler::CGI; use Plack::Test::Suite; Plack::Test::Suite->runtests(sub { my ($name, $test, $handler) = @_; local $ENV{PLACK_TEST_HANDLER} = 'CGI'; local $ENV{PLACK_TEST_SCRIPT_NAME} = '/plack_test.cgi'; note $name; my $cb = sub { my $req = shift; my $cgi = HTTP::Request::AsCGI->new($req); my $c = $cgi->setup; # Fix CGI container parameters $ENV{SCRIPT_NAME} = '/plack_test.cgi'; $ENV{REQUEST_URI} = "/plack_test.cgi$ENV{REQUEST_URI}"; # Apache's CGI implementation does not pass "Authorization" header by untrusted ENV. # We bow down to it under this test. delete $ENV{HTTP_AUTHORIZATION}; eval { Plack::Handler::CGI->new->run($handler) }; my $res = $c->response; $res->request($req); $res; }; $test->($cb); }); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/fcgi.t�����������������������������������������������������������������000644 �000765 �000024 �00000003200 12631015706 017543� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; plan skip_all => "release test only" unless $ENV{RELEASE_TESTING}; use Test::Requires qw(FCGI FCGI::ProcManager); use Plack; use Plack::Handler::FCGI; use Plack::Test::Suite; use t::FCGIUtils; my $lighty_port; my $fcgi_port; for my $script_name ('', '/fastcgi') { $ENV{PLACK_TEST_SCRIPT_NAME} = $script_name; test_lighty_external( sub { ($lighty_port, $fcgi_port) = (shift, shift); my $needs_fix = $script_name eq '' ? shift : 0; Plack::Test::Suite->run_server_tests(run_server_cb($needs_fix), $fcgi_port, $lighty_port); } ); } done_testing(); { package Plack::Handler::FCGI::Manager; use parent qw(FCGI::ProcManager); sub pm_post_dispatch { my $self = shift; ${ $self->{dispatched} }++; $self->SUPER::pm_post_dispatch(@_); } } sub run_server_cb { my $needs_fix = shift; require Plack::Middleware::LighttpdScriptNameFix; return sub { my($port, $app) = @_; if ($needs_fix) { note "Applying LighttpdScriptNameFix"; $app = Plack::Middleware::LighttpdScriptNameFix->wrap($app); } $| = 0; # Test::Builder autoflushes this. reset! my $d; my $manager = Plack::Handler::FCGI::Manager->new({ dispatched => \$d, }); my $server = Plack::Handler::FCGI->new( host => '127.0.0.1', port => $port, manager => $manager, keep_stderr => 1, ); $server->run($app); ok($d > 0, "FCGI manager object state updated"); }; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/output_encoding.t������������������������������������������������������000644 �000765 �000024 �00000001354 12631015706 022051� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; package output_encoding; use Test::More; run(); done_testing; sub read_file { open my $fh, "<", shift; binmode $fh; return join '', <$fh>; } sub run { my $mangler = 'try_mangle.pl'; $mangler = 't/Plack-Handler/try_mangle.pl' if !-f $mangler; my $mangle_file = 'mangle_test.txt'; test_handler( 'CGI', $mangler, $mangle_file ); # test_handler( 'FCGI', $mangler, $mangle_file ); return; } sub test_handler { my ( $handler, $mangler, $mangle_file ) = @_; system( "$^X $mangler Plack::Handler::$handler > $mangle_file" ); like read_file( $mangle_file ), qr/test\ntest/, '\n is not converted'; unlink $mangle_file; return; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/standalone.t�����������������������������������������������������������000644 �000765 �000024 �00000000210 12631015706 020761� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Test::Suite; Plack::Test::Suite->run_server_tests('Standalone'); done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Handler/try_mangle.pl����������������������������������������������������������000644 �000765 �000024 �00000000341 12631015706 021147� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; package try_mangle; my $module = $ARGV[0]; $module ||= 'Plack::Handler::CGI'; eval "require $module"; my $res = [200,[],["test\ntest"]]; $module->_handle_response( $res ); exit; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Builder/builder.t��������������������������������������������������������������000644 �000765 �000024 �00000000267 12631015706 020304� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More tests => 1; use Plack::Builder; my $app = builder { mount "/" => sub { [ 200, ["Content-Type", "text/plain"], ["Hello"] ] }; }; is ref($app), 'CODE'; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Builder/mount.t����������������������������������������������������������������000644 �000765 �000024 �00000000461 12631015706 020014� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; my $builder = sub { use Plack::Builder; builder { mount "/foo" => sub { }; sub { warn @_ }; }; }; my @warn; { local $SIG{__WARN__} = sub { push @warn, @_ }; my $app = $builder->(); ok $app; } like $warn[0], qr/mount/; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/Plack-Builder/oo_interface.t���������������������������������������������������������000644 �000765 �000024 �00000004076 12631015706 021315� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Plack::Builder; use HTTP::Request::Common; use Plack::Test; my $app = sub { [200, ['Content-Type', 'text/plain'], ['ok']] }; sub test_app { my $app = shift; is ref($app), 'CODE'; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/app/foo/bar"); ok $res->header('X-Runtime'); is $res->header('X-Framework'), 'Plack::Builder'; is $res->content, "ok"; }; } { # old (doucmented :/) interface - backward compatibility my $builder = Plack::Builder->new; $builder->add_middleware('Runtime'); $builder->add_middleware('XFramework', framework => 'Plack::Builder'); my $new_app = $builder->mount('/app/foo/bar' => $app); test_app $builder->to_app($new_app); } { my $builder = Plack::Builder->new; $builder->add_middleware('Runtime'); $builder->add_middleware('XFramework', framework => 'Plack::Builder'); $builder->mount('/app/foo/bar' => $app); test_app $builder->to_app; } { my $builder = Plack::Builder->new; $builder->add_middleware_if(sub { $_[0]->{HTTP_HOST} eq 'localhost' }, 'Runtime'); $builder->add_middleware('XFramework', framework => 'Plack::Builder'); $builder->mount('/app/foo/bar' => $app); test_app $builder->to_app; } { my $builder = Plack::Builder->new; $builder->add_middleware('Runtime'); eval { $builder->to_app }; like $@, qr/called without mount/, $@; } { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; my $builder = Plack::Builder->new; $builder->mount('/bar' => sub { [ 200, [], [''] ] }); $builder->wrap($app); like $warn[0], qr/mappings to be ignored/; } { local $ENV{PLACK_ENV} = 'development'; my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; my $builder = Plack::Builder->new; $builder->add_middleware('Runtime'); $builder->add_middleware('XFramework', framework => 'Plack::Builder'); $builder->mount('/app/foo/bar' => $app); test_app $builder->to_app; is_deeply(\@warn, [], "no warnings"); } done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/HTTP-Server-PSGI/harakiri.t����������������������������������������������������������000644 �000765 �000024 �00000002450 12631015706 020611� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Plack::Runner; use Test::More; use Test::TCP; use Test::Requires qw(LWP::UserAgent); my $ua_timeout = 3; test_tcp( server => sub { my $port = shift; my $runner = Plack::Runner->new; $runner->parse_options("--host" => "127.0.0.1", "--port" => $port, "-E", "dev", "-s", "HTTP::Server::PSGI"); $runner->run( sub { my $env = shift; if ($env->{PATH_INFO} eq '/kill') { $env->{'psgix.harakiri.commit'} = 1; } return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hi" ], ]; }, ); sleep $ua_timeout + 2; # to block }, client => sub { my $port = shift; my $ua = LWP::UserAgent->new( timeout => $ua_timeout ); my $res = $ua->get("http://127.0.0.1:$port/"); ok $res->is_success; is $res->code, 200; is $res->content, 'Hi'; $res = $ua->get("http://127.0.0.1:$port/kill"); ok $res->is_success; is $res->code, 200; note 'check that the server is dead'; $res = $ua->get("http://127.0.0.1:$port/"); ok !$res->is_success, "no response"; }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/HTTP-Server-PSGI/post.t��������������������������������������������������������������000644 �000765 �000024 �00000003067 12631015706 020011� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Plack::Runner; use Test::More; use Test::TCP; use Test::Requires qw(LWP::UserAgent); test_tcp( server => sub { my $port = shift; my $runner = Plack::Runner->new; $runner->parse_options("--host" => "127.0.0.1", "--port" => $port, "-E", "dev", "-s", "HTTP::Server::PSGI"); $runner->run( sub { my $env = shift; my $buf = ''; while (length($buf) != $env->{CONTENT_LENGTH}) { my $rlen = $env->{'psgi.input'}->read( $buf, $env->{CONTENT_LENGTH} - length($buf), length($buf), ); last unless $rlen > 0; } return [ 200, [ 'Content-Type' => 'text/plain' ], [ $buf ], ]; }, ); }, client => sub { my $port = shift; note 'send a broken request'; my $sock = IO::Socket::INET->new( PeerAddr => "127.0.0.1:$port", Proto => 'tcp', ) or die "failed to connect to server:$!"; $sock->print(<< "EOT"); POST / HTTP/1.0\r Content-Length: 6\r \r EOT undef $sock; note 'send next request'; my $ua = LWP::UserAgent->new; $ua->timeout(10); my $res = $ua->post("http://127.0.0.1:$port/", { a => 1 }); ok $res->is_success; is $res->code, 200; is $res->content, 'a=1'; }, ); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/HTTP-Message-PSGI/content_length.t���������������������������������������������������000644 �000765 �000024 �00000000603 12631015706 022146� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use HTTP::Message::PSGI qw(req_to_psgi); use HTTP::Request; my $content = "{'foo':'bar'}"; my $req = HTTP::Request->new(POST => "http://localhost/post", [ "Content-Type", "application/json" ], $content); my $env = req_to_psgi $req; is $env->{CONTENT_LENGTH}, 13; $env->{"psgi.input"}->read(my $buf, 13); is $buf, $content; done_testing; �����������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/HTTP-Message-PSGI/empty_streamed_response.t������������������������������������������000644 �000765 �000024 �00000001162 12631015706 024074� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use HTTP::Message::PSGI; use Plack::Middleware::AccessLog::Timed; use HTTP::Request; use HTTP::Response; # Plack::Middleware::AccessLog::Timed is used here as it always uses # a coderef in response_cb to wrap the response body. my $app = Plack::Middleware::AccessLog::Timed->wrap( sub { return [ 200, [], []] }, logger => sub {}, ); my $env = req_to_psgi(HTTP::Request->new(POST => "http://localhost/post", [ ], 'hello')); my $response = HTTP::Response->from_psgi($app->($env)); is($response->content, '', 'undef response body converted to empty string'); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/HTTP-Message-PSGI/host.t�������������������������������������������������������������000644 �000765 �000024 �00000001235 12631015706 020112� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use HTTP::Message::PSGI qw(req_to_psgi); use HTTP::Request; { my $req = HTTP::Request->new(GET => "http://example.com/"); my $env = req_to_psgi $req; is $env->{HTTP_HOST}, 'example.com'; is $env->{PATH_INFO}, '/'; } { my $req = HTTP::Request->new(GET => "http://example.com:345/"); my $env = req_to_psgi $req; is $env->{HTTP_HOST}, 'example.com:345'; is $env->{PATH_INFO}, '/'; } { my $req = HTTP::Request->new(GET => "/"); $req->header('Host' => "perl.com"); my $env = req_to_psgi $req; is $env->{HTTP_HOST}, 'perl.com'; is $env->{PATH_INFO}, '/'; } done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/HTTP-Message-PSGI/path_info.t��������������������������������������������������������000644 �000765 �000024 �00000001013 12631015706 021076� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use HTTP::Message::PSGI qw(req_to_psgi); use HTTP::Request::Common; my $env = req_to_psgi GET "http://localhost/foo"; is $env->{PATH_INFO}, "/foo"; $env = req_to_psgi GET "http://localhost/"; is $env->{SCRIPT_NAME}, ""; is $env->{PATH_INFO}, "/"; $env = req_to_psgi GET "http://localhost/0"; is $env->{SCRIPT_NAME}, ""; is $env->{PATH_INFO}, "/0"; $env = req_to_psgi GET "http://localhost"; is $env->{SCRIPT_NAME}, ""; is $env->{PATH_INFO}, "/"; is $env->{REQUEST_URI}, "/"; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/t/HTTP-Message-PSGI/unknown_response.t�������������������������������������������������000644 �000765 �000024 �00000000775 12631015706 022562� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use HTTP::Message::PSGI; use HTTP::Request; use HTTP::Response; my $res; my $app = sub { $res }; my $env = req_to_psgi(HTTP::Request->new(GET => "http://localhost/")); eval { HTTP::Response->from_psgi($app->($env)) }; like($@, qr/Bad response: undef/, 'converting undef PSGI response results in error'); $res = 5; eval { HTTP::Response->from_psgi($app->($env)) }; like($@, qr/Bad response: 5/, 'converting invalid PSGI response results in error'); done_testing; ���Plack-1.0039/t/HTTP-Message-PSGI/utf8_req.t���������������������������������������������������������000644 �000765 �000024 �00000001051 12631015706 020666� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test::More; use Encode; use HTTP::Request; use HTTP::Message::PSGI; my @paths = ( 'П', '%D0%9F', decode_utf8('П'), '%D0%9F', 'À', '%C3%80', decode_utf8('À'), '%C3%80', ); while (my($raw, $encoded) = splice @paths, 0, 2) { my $req = HTTP::Request->new(GET => "http://localhost/" . $raw); my $env = $req->to_psgi; is $env->{REQUEST_URI}, "/$encoded"; is $env->{PATH_INFO}, URI::Escape::uri_unescape("/$encoded"); ok !utf8::is_utf8 $env->{PATH_INFO}; ok !utf8::is_utf8 $env->{HTTP_HOST}; } done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/share/#foo�����������������������������������������������������������������������������000644 �000765 �000024 �00000000000 12631015706 015444� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/share/baybridge.jpg��������������������������������������������������������������������000644 �000765 �000024 �00000034636 12631015706 017353� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÿØÿà�JFIF��H�H��ÿí�^Photoshop 3.0�8BIM�����BZ� San Francisco_� Californiad�USAe� United States���ÿÛ�C�   (1#%(:3=<9387@H\N@DWE78PmQW_bghg>Mqypdx\egcÿÛ�C//cB8BccccccccccccccccccccccccccccccccccccccccccccccccccÿÀ�ô�ÿÄ�������������ÿÄ�E�� ���!1AQ"aq‘¡2±RÁÑáð#3Bbr‚’ñ$ƒCSs4c¢d“ÂÒâÿÄ�������������ÿÄ�#������!1AQa"BqÿÚ� ��?�ø…@ 4@ hH @éH )¤¨)@R¡ÒH @RRH @ P$€T @ �€@�€@ H@ Z@ h€@ h ¤ tÒH @éPé@R¡€¤ T TRJ…H¤ H �¨ �€@€@ €@ �€@Z€@Ð@ hÒH tÒH yPª€µ•@©Q$( TRH )@@ $� €@ �€@ H @Ð@ hÒH t€€‚€@ÀAA¨T*ªnª(Ê‚KP"I$„„ *@©@RH� $@ �€@ H�  ˆ 4 t€@ÐÒH t€€‚€@ÀAa¨(5†  ÄCȆ*Dµ¨¨!‚HA$ D TRH )@ H  H @  �€@ HR¢„AH¦ :@é¤  0P(E °Ô5¨,1 b ªDB1 ÍÌQY–¢ µ ‚I$„ *@©©¤ Tˆ) )@R @ H¡�€D$�  �€Aª(¥T )¤:P:@é�€‚€A@",5Q£ZƒVµ­b#F±Th#îA]Vˆˆth¬œÅ“šƒ'5›‚!‚H@ˆEI TRH )¥J„ )T€@�€@€D(DÒŠt€¤:@RH tÒ �‚€Aa¨-­DjÖ Õ­U±ˆŽ†Gj£vAܪ,Á¦È1|H®wÆ¢¹ÞÅ‹šŠÉÍA™ ! D ’*@©¤ "¹¥¦_q´[14ˆ)¤ R*@ )¤ )¤ �¨HéEÒH )é¤P  ¤  €ª4hA£ZˆÝU±Ù j£ÒÂáL¤�5DÇLýøÙ˜;“W\ÑUªŽ9X¢¹$b0{X¹Š ÜÀƒ2Њ’!RH((Äæ€\ m¹›`ö†Ú{ú rd.ƒ°Ö4?)í[Žš“öiݪ—âϪ31å…ð³+MÝ3ÐÓóÇU'Õ¿bŽMcu8‹ÈNÕwÚ5gKÓ{­ÂÖ¦"H.-¶YÇÂwØñØ Ê• R ¤  )¤H AÑJ)Ò ¤”ÒH*:@ÀA@  Pj Amj#V„°Q»�Dtƨ톕G«€™±<²R= F&# �Ù!Lk^#RV˜pJ¢¸äQ§;ÔV.2pEA ÈEI$„ S"Ì3LÌ]½_¿‚ò˜ÚÖå4âýž‚?… ÍÎkIƒ¸!Îø…x  Âb^ö—\çÙ$êJU‡ÙÓ(ªy)>¯á-"Û#Øàæ¸Ø Ö‡uì ±,o#®Šø’ÃNqï&ôð  Äü¹'h$[ºÎÈouñ>‚vVµŽ1ºŸðø¼e•¤ R*@R*@RJ‚” •" @RH AÑJ)Ò:@餑N”• ‚ÛÝYXç[ƒE'`¨ÐÂö¹Ã#û;Ûj¹ß%4 P-¡£B£fFÌ £¦5QÕDuFúU:C[ æ‘Öƒ’UË"0xA‹‚ŠÍÁ ‚IbÍEÄ1…ÙK°>Zû(V–VfkÖi¹Ý¼ôûP'Ê:Òñr<8Ôb¨[u¬ É4)ƒ)AÍo™/ÅŸZ::Êàl8kÎøßÍf}ƯÍM-0)¤ ¸¤’æ‰îÛ[ òA«q.¨Û$qHÆ]5Í«ñ"‰ó(`a¼F$d±’ãì!Úr 5ó@Œ9™™ˆnbü¡¦¾±;{¦„ü­dÏ¯ŽºF<ÙÚ¹¦Œ¤‚HžY$oc€²×4‚‚£<¨ ¨TT0ºSL*C •«5t¦ÅÀÈŸ%äc”r‹ 7> ¸˜’)T -’áå…Á²Ææ8€@p£Gb¦® pòBØÝ#hHÜíÔ_²²–c*F]4£B:@餀‚©EjØÀhsôùÓ×KU3ËKtªp¦ùx©F‘Lá l–îÎàÑöðßC¦¨¸è¶jÊFc¾Q¯ Ûævå°UÕÜÕÙæ5B 4 ÙŠ£fFìr¨Ù¯UdC9è¸ÅîQX=Ebàƒ'™j*r]hk@Û‡·yŽ`)šî/}½Ð"Öèå³Z‰7ÿ�Ä×çU4ĺBd.`9‰';Žgø)«Œ\ÓÅ5q9 :Ó Ñ–î+DÓ0“A4Ƨ£±"|?ên\ eÜÕ×,Þ[<jqʼ^ØX‹œÒÒò7¡>åŽ<­ä×.9<g…ÁMŒœC Þn€]-Æ1.¹±ç%´^¦û¹'c«�Û#½i—Sð©/{e`xp7BëZãܱÛ[êÂHÚÙr±áí€à+0æµ¾3Žœ “áä‘ÒµŽcm­;¿^«6ÝÈÔ“6(DD½Î5Õ€4:ë|•Úd`ƒù©V]¸Ì>,;]…Ò ++¬è=e¶µdˆ’n©²²'È×ÑlŽë 6Å ä¬Ô²3½ÓÁÖ67ˆâ!¡ñ‚*œu|ÖªI-mŠú#ß0Øg=Ãwó£lrãÊÖfµdN"\°¸3$&>È,xvî'µ` ­Ò2Î8pn™ƒ­­æ’âÝYª;mî­¦:úC蘘a’9¡‰ùC2^ÐkBnŽ».|v~7}c&#àoJáz¸‹œÐö¹¤Õî­ÈÑk·¿Ç!ÀÓæâðNsÉìŒCAÖ·û»&;g— Ü#±Ø9c„ì¶Ðq²ou™›«oŽ1†2ñŽÃF^×4O­w×˹]ŸÂGžÉ¯ÊÖždžoã3×S0ãèñÌ&Œ¹ï-‹.ÄŽ_5-#|IŽ\Il˜îµ¬`ce só‘ >5íC°ØVÂÇ;Cßû½C衳ÏÉ;Ffì /£†žI9Ç%ÝMÛmõNéÕ*‡H§H )¤0ÔÈËÍ4Yù Ù¬ ²Úq¸ü-ûÎßq$¸m²ï®wòåÁ4`ðAކ¹´ô*,[X¢öuñPl®Ž†Lðlö3¿®üSSŽ©öH-åïËË‚» iôRlÆæ¼ øýÈ„a{ 9®oˆCAM1°cƒËNRjëEtÆÐÄùlFÒêk€ML�ꮳa>FµÔ\ï4šb ­úƒðSW7ÇÀ^d§]d ³µ…›nµ“íïxh’®Ê£ªl ÁDûx”‘˜m £¾¶±/­Øâ11£]Hi٤꾵ö­jHÛ¤z€ðÌ<dšÌ‡‰H�³*ãŽÆé™×ÊÓYfæB5ö ÔgŒ› $Ž0˜£hnަ”šÕF,S${á|m}¸8öH¯’—Hx·Ç;ËúØ[ÙÊA«à4o%8ìü[”°ÒG†ÄG8~`Ù‡êžEéWoð‡‹‘¸‡ %™ûCèYºÅI³ñnW5ˆŸû9I-й™Gu;+øGF#¥$wJágŸ­al„Ùü £ºIž—ødÉÌøá†\ö$q¦ù¿U›3—eöÌV,TX‘Põd<?¬/¦¿ÄVò˜u¿Â]‡Äƒeku’GÒ�k¹;OÄÊÅ9²Óä‚&FOmî$[kìµÙ:“\(d¸ˆ#Ž0FˆtÐ:Ôÿ�ñu”nˆK–LDQ±–3†ç=ÚfÕ_YñPÍ %Èü[[K†f48Ñ®®Á[¿„Æb|8œ5Ø«…®°CFjÓ»Å,¿†ÆSb "Þc°[m·+É_SR1L‘$ïÊçYüô›L^ßËlV3烆tìS³¸¸»ná§ÈRJvLج'VÁq {E9åäæt€áæ™SgáŒ^aà Âa¨—3x ÓÇ»Ñ%ÒØ˜1XxØCðŽ‘ÄÑÍÙ< ]>e/jpؘ`vy0m˜Cemµ[ÆÒX—âàë̇ ܼ@ à+óiÖáÚ'¤c™àŒ3"kj›�ý·ªÝ8ñ³õ;EÉÒí|-„aacA²ZÐ A5g‡¢NiSK;ܬŠ3b‹œÐ㨠ÕðßNÑÉ4�ÕëñejLfÝuáãÉ…ÌÑ©i$¬[ë|~!ý-Ž—È;ŒM9ƒ(�<–ºÆ{TAŸ ’'–¸ÓqN²¯k ~–y]$”縒\u:÷ž\qÄìné<KͽùëA›Z¼œƒµ¯`29ö=£µ w›v> ßr¾Ufì3Ûzfr8xǘYÁª)†I¡ˆÉØ_‚i#ÃÉ#²±Žsªé “I¦4ƒ6"ú˜Üü¢Í ‚èÃôsåa{[œ�Nᢀ»³¸ðûÅ2²'–˜Ü#nl—•ºqæã麗’Î%â#{Ý+Zcm†‘WÜ+AºÍäÔâ Á²Häsä,sZKF[ÍÝÜ—‘8²n®’<òd¢âhl~b’òð‘Q²àçK(Óx¿ÍgÙq|­1_FlÎ0<·h.Ì@泌ÉLèÏìâ{Ðã‘ÇSÄé¥òVD–±Ì0KÙu8õDNÃ墚:Y;°ðNߣ<“L.,Ó®‚ÏçTûT¢ÆM…‘Îêä7 Fêl÷ëø+»ñ0KÒ/||‘Àã¹Ï#5Ûm7Ð{÷«*XÒ­ê[ †4 úâ £\‡¹Þ•‰¹jL3Øpëžr‹ãùâ¯üOŽL_IcL‘0æÔDç]Wï[Œ×—.&G<æ‘Îñ6•#¿ ÒÅmv*FÛ DG]5üo¹bïängëVt–!Á¦1Šs4 ˆ[§kÊø­#AÒr²À¤��</NM)gÕ˜‡ã12 `ÆúØ‚=5ÑL]b]3·Â>¸^#ói‹¤çLu 3]Ï?ÙªgöšC­'\6 «Ë—0$l®“N% öpƒ`XNœuá·šaµ&LifS,#}C ú©á´ÌØâðÿ�¤±®í±Òd]¬Ë±fïEŠ5Ô&DÚŸ÷:ÿ�»“Sd¯4ÈmNItÿ�u6†ÅV‰áêz·Õ}"jªøø+áµÏˆì9äy×âuúz¦Y°1Ó†5Ï,#‹»•Fÿ�G‹ˆqñq@¾ý°š`ú<#þ›SL>¢!ÿ�M¾ˆUÔo¢#>£}õG¢€¡Èz )P —84çPIAÇ>+8ÊËŸ©µÎ\Näú¢@ 2“Àú*‡‘ÀYi¥”¢´ckCÍÚtCañ½ùç”´2"hxÇï+ë®ä€ƒòÑ.G�]@�(w’¼¹X“Œ­eè3Ø]hq”±À0¸± ˜óÓ€V’f×?ò^²Ù5ä>‡Pq"δµ9$øC\,ZvKÊGЈpÙc"pò~6h+m›ÝsµéÇdOÃÅ3‰3KËÆœè§z½bN*n#׿âër:½|íü§TÏ‹À¹ŒgWF;· Cl÷ɳÃðMßÄÁ‰ÆÀ÷3ÖòHiw ú­뺿›‰³~£ýUÌŸ¬Êâö´¸DüÛP¢O/d›ü.Ïå?êD89‘Ì؈š+À¸’»Oý2BIêñ'réZÉK !‰–ÍaÅÄ;ìW .ºbܽTT-ï5ßↂéÜ� ¶œ]B"A¾`ðîS!®lCe†„N6ZÐØ@áïæµ1-^YúáX—ˆßÍ`�‹ÔÉ,5Ù–wŸ‰uÐ#8ÃeŸ'çºß‰Äºõ7&êèBˆ›wZãß#“L_Ðà 4(j<UÖqG †s‹Ž!|hz&™†0¸q´`M1£bˆmcúº˜ÐšÑäyÝ,ïÖB?„üÖ¸±^CÏhª¤ ƒèp'ý„Èj¶%A%”PIA%”PIT"ƒ“eñ�h믢±*CxÆ4U§¡AÔ¢’!"„ )¤ TRl`Y}êÆk”®Ê²Ò0ÖÂüÀf#Nh³1›tyÞ¨ü•BÊw¢ƒ¶ÒHq¦ä:žiïJ5Z%¹Ãl\ *OG¾ÃºÆ�Nš;îPÆÑôN"^Ó-À¸•Ž6yl†=ŒzS …v»!ai&7 +ñ\ï nës–LpEÑX¨€`d„Cs3×rÝš’ãч Òt¡Æ†²9 ö\)£³—ë^Ë7ü|lꓞ]Cÿ�Dq ËÖbbœÐ;_[‚éÖ1®ÈCcºG+´ëò¾wéFYžlCÀ&YDx�±˜ôjÿ�Ù8 Ò5ßÌçšžž:[ƒŠdQÀ€ š¸®§.Íhð  ÈUB,M *šM7M 15T#SEˆÏ"š¸æÆ°çÃ4^tn„ŠÖ¼•ã~¥Š…ŒwIEÔƒÕ9ŽÊF€ž5ÝöÚ–ùêÉëÓx¬voªº„ìaõ)Ù0uJêa�®¦oŠº˜Y{ÕÔäÓ_Ké4Bÿ�pü×N.|žK·(£èᛣà?Ãö•‹}nOŠjâK i‰,îM1%…M1&2š¸ƒM1%…51…]1©¢KJº‰-($ 'B(Ö¨8ñ¤Œ¨ßªÔJ† [3ÞbEÚÌ«*‰\#Ï<°¬ÛˆcŽ› Éà®&µcšýŽªYbÏT�ÔâTÕ'åc÷ÈHÕdSL,‰¦Mj¼Õ0d ¦8:C³3k‹~Õ®?äçŠÝ™ÄXcs]àr´ÊzÇsÕ ,î't5¨ŠC³¯• ÔÑцÁÍ$€<=¬ã`„Y5èœ<$&ÌüAa/ôvª¯=Õý1Ûƒ 0~#ì<¶GVYÖf¦•ÏD°ö0†H¢w]¤m™ ¶½»–®dÄã·uèá¢v' ô‰exÍl˨Ûe&o«Ê_þY͇„0;ÞZ ‰ ñ…«×̬IÏÝŽˆãÀ734ÌŽH†`átÿ�M¿ó¿YÏògưb {Ë1’Êæ4·«uêÖT³1«Ç“ â:9š5ó¼sÌBÖÆzr|#'tr—†²Î…¹FZåK“¶ª9 ½d/«×$•§˜E×~…½Yl”÷Ýš¦ƒæ³ejXõŒmuÍuFÆö¥†•ôs’Ò(ÖÜUe”°9®tnÛ¾ †¡±f¦BÊ*º§†f,¦€ ³½ì¦ !Îc²‘¦¼·SZÆñàåq¡4#ŽÉFLjhÌbГ©#ÁOWÇŸÒY7"7·3™Ù@Ì]]µÇϬòüi„õ½=†‰ïÃÆÒT™ãŽu¥éµ¬òÜÅ—Ý{òà™L‘´d=ÚRãîåuÙ}KpÙãk³ÂÜ×@Ê>ä-L˜)ã‹9c„þÕ»©/êlü&àç-³M¾{mTØäÆÄì7jG1 ‹øÁù-IY¬ðõ3{i¡zš¿¼÷-#O£KÕ—äÐÔ€¬‰Y±y¦±Ä÷Ï$GŸÒxY.œÂcEû+|~9óúà8 7¥u—9Ã<8´´ƒµÅ5~>›¡°r»£#¦9Ô]µ}cºçËë¯1è3£g}v+ÇN³ë^389sõ=ú«%M‹“£ä kÃ)®h"Τmt—Iˆÿ�N”¸Ⱦ$¬ëLÑø‚ü™u«.¯ð³ÙqG£q-pY²,Yû«©ã–l&!‡)úî4×ò ŽYXèžØävÙˆ ²Oûµ…ÀÕAßQ²£!¯›È‰Ëæš•CÑiI#b=ú4UÐWÍŒcÎ!´Â2y´âš¶X‡6CŠkòÉ i¢ÚÛtÙŒþº‹€ÝFŒ‹6*.Bü#²ìÍ�Ð: uóÕtžÆ6ñ­äÅaf·# 3Н…ÁY°ØÖ,N °²¢säk‹œî²»$—mûÕ¬ÁôŒÐ<;õrÙ©³Syeâ{Ô¶ÿ� $þI˜Y$íá§/ÓsaNÓö:u·å3H3“¼ÁOüTÎjÓözØ\ ‹ªdßßÖ Ï›¶ú+ÑžÎl[†!ís86¨­qãc<®¯ ¡òd/n]®©ÍDŒá²C«ÜÞv*”Ö§ e¿ÁýdÈHËã¡û•gî'£°Òà°I¥a !À‘ülkª³æ§ë§Ñ@é¡~>`É^ÓMn¬ jI:üRÅ–¹›ƒb pºi­ÔÍ;NòQÓ^¦3ôgè¸x_.#4’HØÝ4žþ>ˆÎïãÒoè>0]ôév;4éh›ý<ÜF²l@bC3œŽi Væï—د]õw ÑñOŽ8pý2fê‰$é¥_z·Ž®/ÑÑ`Z]ha¡®¿Y:ù©9[qëô<NÒ¸BÂ^EvñDå=sgÄâlÂ:¹Lb hº_t>?:ë?…¾ŠbéõŸÀÏB˜iõ¿ûlô?za­¢ÇOCcy`A¤®üT꽬hÞ•Æ4‚&’Æß¬‡4êv¤î’Ä>³¸º¶·¼ÿ�ù'_ìíýú†"ÉÌë"¾7íËâN§c!8­NŸÆï½N«ØÇHOÍßýÇýéÒëFt¦!¤8X؉ÍN‘{Õ»¦1o6çÈãw¬Ï?j—ürÝ«9ÙñÆgvb@p']$wßÞ}Vñ‹É£q$‘…ÕÎG}ê^;ú³–:‡JJÖ4¸4i]k©cýq¿öT¨ÍÌÿ�qWýq?ÙSôùH� Å?×öU·±s\HãÖèwfq 'HÝäåz¥ä¦bòŠhéW*vmô–8v™+¯œ§îS*ìtá¤k¨È?å?ru©Ú:#è\F"Ý Ù3jK¥y¿:Õnk6ÃèÇIå#é1¹¤mžJ>ÈšâÄt>:\’Yl=þÒ¬aš|™™,ÍuQË! XÔ®¯õY‹uÄc/ºoÁsë];F/é9¥ì>|S™wF_Á:'e»Ùý¦,ÿ�Ëÿ�ò¦Vµ‘é½ä¾|Q'rdû…ofrÃ~7KâÉßYܧ_é{l†9äë>"ª¾1·¢½'ðè~4‘]~(øÈ>äéý¿²n(:ób1@?h>årφËô:XãÖ9ñ ÿ�är™oØlŸ5à8}3ÜÂR}“3ä†Ëõœ²°‚N#x›pû•šŸùyÎò±¢IàÁM³t.Ϲ]vÊÈ~†^é±FS ¼ß/ \廎–LÚç׿Y>{ �þÏŸ©Z»¬dÄE,­'$ŽÕ®nûêØJ¬Sbl­ tŽ,º¬j§Åå‹/wWÕ2I2»²A¨êU›ú—Ìsžâçuc^6H ˆii½4>òØׂ HiMNÚqB›1X†|Ê?¨¦Cµþ]Œi§ÉdU‡�¦F»r°¸‰Ië\ââIÐ<)fÈ×jåé([!d¸6:¸Šû•’þRó›–4Âu/˜ÎÁÕ1Ú5º[GÅk.1³v;#ê(u€ ó:~¼}“Â=S‹Ühæ<yxpU2)¹5®"·C#LÙ›N6.Ñd‘¦6wK‡Ç&Ù€N;„<m‰é ^1™13>FÝÑ�kÏ@†E7¤q¡…£5â{ÉßZC#™ ³6LÍÍ¡¢uÒ¾Jí24ŽIc”KÞ$ƒµ&ª’Úd9§ši¥’G“@Ýì6SL‘¾ŒÂÇÕáç’6tÐ7ôPÈ‘ŠÄµÎpšP^âçÄóTÇÅêŒ @ j)ù <Ð/5Qm‹€Qbò4ÿ�ÔoªŠ:±ÿ�qŸÜ>ô@#]¿Ü…|mõQ@ˆº¨:½x$ÇHì›ò¤·FÃo²ûÚˆû1sƒj¼Gc°q¹„ˆÁóAó½5‡Š!Už|œìæ€>�¢Äõ-–€?•c[fÈZ_D·óä—âG|Þ =´Gu.s—®·Ža3>…ß‚ékœž®l Œ³O�e[G„‘ç²ÂV­Ædàåãm¤²­”E�½}ŠZHsÄ9ŸdãW‘A N=¹ƒ{ÎÉÊÓŒˆÇaÙD²xÞNš8'jrްV®{M4kzKl¤¼|n³v>Hjsi¿‘×UÑ Øq¯ÈE[Þ\_nq�—qÔÚ‹Dp—³mÛB|Ñ?Yæ!ƒ^ܪ†âKÍë¯àƒ£Æ—%åêè†I:è¥kŒ9`„¸È] ”´j4$nªYÌë e.xZ#£¤Œ/Ƈy1–´ÙÜiªÏÏZå–øÃ1§—­�V™KžíœxñZˆÐõƒxÜ<ŠÞ§Ru|Ñ5:¨>·jÖ¦:ãŽçM $jÒê¯ÅsåÊÖøñ‘xvá]…Ï#âª.G‚œ¯-^2be•…™u£~$· #9r2&æ’IuÉYo©d@p�ÛðWi‘Ó„cf–£tÝÔœ¹]I#éÿ�Gú7£q5ƒrEl,úw­Rò¸c—§0x,6O…ˆ0Ðòl½Ïr¼o¾¥ž>“èCú?‡’X0NyÃ9Ï .¼¶lóY·ÿ�K$xÿ�¢}é.‹|ض—ÈÙ2Ù·L<ù’­äHøŠ+ @ h�¨:QE ~H !.<B�ÂÐñ(ÎèŠhoï<�A l?\ù´"´oÑÁÕÇËE=<hÓ‡$S_ã=<vÀ!uQ”‘ÀGÉ=<{Ý$°~°¯’¨ú<1%ƒ6Vÿ�. …QRõ²ak\6.úEû ò:CY™Îkkø€w¹AòøˆYÖÚýzù;£Ã ìÈÚäñö©ë~3kp­u¾I@ç˜_ÉK«1OŸQã%'êšÿ�õY˿ٟ\fZu¶Sã`}‹XƵÎç%×¾P}©E¤ÆÌM7Ð=ÊÔ‡+ghíK¼,©1n”2¾#û„òs-,Ò\Í#Ž¡ƒù[ø$‹Èa¤Äg—gø-9ftcL¤T±ÿ�)Ç?ZóËWܺ9¶tXsË›=kµ_ªÎÝo&1Œ»­g"î¿$L7F‹CÚײˆž©¼h;úŽzÉN é–ôÊ{¨ãcœËª7Ìó ãZ§JùsŽ”˜n²êÛü^ˆžá~ˆ&€ß@ƒ«£ÝòéÝ‚¨ÕꩇYÛ¤O÷µßí5Û‰iA}¢�!§ô¨{ü¨ ŽØÆèoÞ©ê²Mÿ�~#ÿ�CÓËvdŒŽ]X¯’‘ÃÈçmßö‡Ü†Qñ·hüÌ¿±pÚ›ƒãr»“þ$á¿úl/ö¹6Ÿð3’@ã…Â8±m)´ÿ�….HÓX,+IâÞÊí?âLPÆ×àa&·.»M©ÿ�WV~©ôYÕÃGЦ®+ª5¨ö*i†"¾Å4Ã0u_á)¦ƒ˜?ÚTÕÃ~iM0Ä#lŽ?ÐSL1í¿´¦˜}E|L#Å´šbLC•¦˜È³_„­2Ò8 ¿uKVFÇ(|z¬ö\#…mî}Bº˜_F5`;ŠºbÛ„q³w…4Â8bÂïP®˜ïÅ51¼Xw,‘ÝbÓL{}†ëÜÏ9I£ZÑUU„À´4fp-ï6>j£©Ø–žÃ<8 òºKÝAmW ƒäºBEžºÁØf úYPyƸHáã! kxͰÊMµÄžyÓa#G7“/\ü¼‹Í,øÖV) í{ʺÎ!оõ*é‰18ñ ©…Õ>÷ ¦)±ÈÓm&ûŠž.PzÎ.*†Þ¸j×8È©á5/|Çâ’Câò’CÔ†»Ÿ©*„YÜßU5p¨}Aêª.nÄ4ç8îR™UdŠìú(ˆ7ÍU-P=y +Å,´   HV]å÷@9{‹‰6u: ]Sy ¡Oï{)¦,`Áýÿ�þ)¦-#Í1íUÿ�¢âªÃÙêPOú^1»;Ñè$à±Í5ãúÊ n¤ÝðOƒÊÚ>‹é§šŒLOtŸŠi®¦þþ“ælŠÿ�Êß½4×4ÓÌ~Wɱ¦áM5¿YÙgF×,wÖ‘MS‘ݱ*Yá/¤%¨œlØ< g¦øouÇØ”Hs2¼žî)>éÄðé²h‹²—âϧ€™à8f’üIôBÛsÿ�XáÝiHQ8€ìίꤤTEÎiÊêæïÕ*Âlfˆ% r¦˜â”ú›[Žu¶­Í­)ɨÞV´ËZOpY‹PçÉð+Q*sWï äUe¤M¢5×¼›QV惮nÐ<Ê×k˜‚<ÕJÚ6Ç sëžeG·ÐñáŒÀ€Ç;}NÃÌR±›¯®Ã� S²Ó-x ó:IÌêÝc7>ïdÒ:YI9€Ói×^ß5*Ç�êKópXt„Â3jâ •cG¾ÛÙ`púÔ²ÓÙ:µ¾«!î5«<x$+Ÿ°N Ó$üœ(øjЍè~éÛ†Ÿj•a;&Ã~E!Rưü@7Å.¤)Zì}R-8ci=«ªZHÚX†]E™[Ç Ã¬®[šÅÃgWZçþRé XùDx)*Xà º¢¶Æ-°®êjãc‡š6ÏMLd`«9]èšÖ GÍ„W5u0uDšÈï$Óèä‹�ú)«Õ›¢p:‚®³ŒÜÒ8*‰¥P袚"‚+¦¸µš±¼6^’|KѲ]màè»÷Xå­ÉBz27Ad�+’Ï«ãæzc vG¸?q] ~å®<ª^1Ń”—êý‡ —G*ô°¸—6v‚@Íè¥fÇÖÀ3aÁ¶’v-DyÓÆþµÔÐG©ûP|6ÖvAîXz²AÖ¸€ ­–x³ê®#`oª¿§âÜæåŒƒ§s©@bOm¤<}ÉÇá~œEÂS«H­J_‹>ˆÍÊsSG;T¿}i‹3Zod« &g%ô´÷¥"âsš×�hcu*Æ@ vgiÜ/íUÒŸBµ­p÷w­)V:%§ÆÚ~+1ªÊFSF£ÍjVi Ãy�ðÑToŽZ/g¥¨¢ËOÆ<‚ =aÆ´…¤­Ã\57ß²Šô:7,okZ#�U›ñ L>ë âèƒõii–…Ïôæ?±Ïl?¸m{À(>>RL–ÒKNÀ°ûT«gˆàà¹Úë#Ÿ«s¤¡d"O®©!`´Óš´»?5õÓ<q´euï÷-0'crê}ßá!\à ì|™„ì×£œ<TU@<Š•bfmy¤)Ädz JA4nmƒî’•1 ²¹Íð)HÙñ¸7WOYÖñÆðZão+QЏØò,f>J±4‹¢RT¬†ú‚´Ê÷ª.Q[ ËY}J¬ŸW˜Q�U,ël^Ê5˜ùeK ­®gÀ¥Ú7 ãe!Y8 ÐíÍi–Nñµ¤gÅVE -™ŒŽ!E×^ÎÍ¢+è:+ˆl­†SwtO…}«›­n%â!£­siò;+ÌÎ"™Ú’¿cEo‹<žnî:àº9WNãé ìuttüðJ•öxg·©¹8ƒ>Õ–@1;÷ƒ{ŠÎ?uµµ¬;´kÈ”Ù;z'âϤ\iÖãÜi�]ln¤ÅLðü¤>ø$/¦×³G“[iø³èa<–Õß$¹‰ú#sÍŒÚáüR‘l$‚ j•báuXpÛˆ*ĶJ.§ïÀ#–G<ºí£À-Æ+\+¿XÖøRœ—‹ºbÐ@ËV±¬@mærÔfŒÝEŸ4Fñ““zóû”« ’.¼ôZf ö\ʨ¡Z²€±÷¸<È2¹‚ˆ;UÄ×ÛtIQOk}U¶Aò¿¤R½9ƒÜÚ: îmln¨t ùN‡(îµ*ÅŒFVÖä¬Xé+6ÎÞ°SADýtË‹ae¸žv±#¥±ÄÙH}åq–ë¤Ó[eCÂÔ‘ms6j? ôVÆe–ÒBÕE3Бꥋ)M1qíj|BÒ瀴¤8ôðHQèéòJ±¹äÔ±ë‘îíió[ŒU±æ«äå0ÔË);ÑðIÖAæ÷¥¶eU“ rŠ¡Ö}rˆ±›‹Š³~»—+¡­ûÉRÙmÓ1ñIKkUQ“–™Eê¨5Ñû ÷ú!õ ÑÞ#ü®|8¾­³»ª�5¹kb|ÏMâ_M�àoÕoŠry˜sGb=—GL¹Û•®õ‰_Y†Ÿõ#[5½þ ,™”Ë}-E~w{(êaôNȺy!ª�]CѸænÛw)<)wURç;»ÕØâí>iH¡%^EÓlš4BSkÜ_Úƒ OjÉZŒÕDúxÕ)RÍudž:’±#v²tº|CÑkµ"m(¸R¸š¶M”hÿ�@¥‹(ë€;ú•q 8'WW‚ ˜öq'…ýŠšô:5­34<4Y ]b¾J³¯¹è·†GEÍ6xWØG¢çSoT3Ó‰ãœÕуã'pŽG4iÌò¿š‹×5ÍgÔ‡ë ´¢´28·f5œiÏÛ.áäV™2çËÎÐd^Aâª$¼“¹%5ïóR¬ï½]~h½ÜýÒœâu: Mv]ÛiV,Ê Ò³‹¬ÜãªÒ$þæ¾ ›÷H•rZCphQZ nˆ:ÓUö©jK‰ÿ�*‰Ìyûª‡­n¢¥ÀóUšÉÞ+L³%T€´[Åw¢w¢sBû‚çÉÓ‹ê#l] H­A ¾¥ˆ8×K\YäòÑzW­®®UÓ…¡3M Y¯¥Â;3�Êß',2ê†Áçvv<Á.â4@uœÏ’a¤éAæ˜i |} <×ÏÑA5Ü‚ÃyR†oˆA™hü•QMcJRF¥‚´MiOxU•5–w÷A Ž…’Q•¥Û½²£¢&†‘nÓ¸!s¢™�Êó3ãÀÝŽÿ�†‚¨û,V-ïpïGI.;‹çH<n’pŒmXåø ù>“ÌZ'¼“J!ùÚê ÷ÖJÔOk–ž 4¬î¯€,«;uíóUß� /‚ ®(­ÓÀz"Âp×_t@]R"Nnz Mct«W¯ªÎ®3ttu*êb™Žƒæ–˜ ;óCZªŠ£È¨ª j¨b1Ƈšš±.ˆo¢JbbÇubç§zš¸Éíµ¬œ™B¨H‚‚+x¨‘h=®Œtf@Æ·SÂísä鯾ª6DØA|™4ØZÃO˜é|I29¹-·ñpù®œc<«‚"=y­¹:"‘¬•¶+_¨ú|;ã §\VYwÅNŒ­£ÉåùB:aåj. ¡” 2x!Š <ÓWOâa†w©¦R6´CÌ«¦R8•‘®¤ª‹c{ýéJ±¡nš»Ð¨¥]ê¡‹æÖØÔ„SÈÞH ‚ÕFÍì·îE{=C]˜HÆÞ›Y=ÝÅV_o€·GtúàlR¨ë}åПD/IÆ—¾7:ô.«Añý#$”±•µ°q­øÒ•^s£ÓBie¤†7ë⢴!¤J4ÁÍ[EY#—˜ €Æïj ¦òжQ;5) ä €òR- p½€ a)¸ŠÞ¼C skªR6p±¥5e·;´:j´ÊØíµ×ÕJA%‘n Øàˆø¸­2Ó- ½rŠaÔ8*ÊÚXGšÆR4n‘*Y¡³ªµ"ÜæÕedïc5‹Á QŠÈ­!"„@‚ŠÚ#DrAêà%„É—+CˆÔ¸ŠñšÅoŽ>¢)‹pÀf'O.îõÍ·ÒÁ®y, .;ÛŸ5¾,òy¬ì¸îÒº97€ž´P£ÎõD¯{ Í ÜÀðʲËÐa˜7³ŸZ: -c½v€Óò4Q}ê xR'MB"IUÍÁJ±¡"õE+îU ƒF¹Õñ{ ,í~È(8Õièª4ji¥Ñ˜GÍ+r Æ‹‹Fs·:æª>Ó¢�dY oŒólJ£Ó|™[»|Í ùþ˜-•¡ç k~.®FëãAÈbpR±ï4†Isž‰±¡ð¥Xå$ñ>Wk-‘×  |!«sÚs :qYiÎNºÙñ L“«-‹ •Rˆ()¦†õJ,,Üt(NÛxn€sôÓ_4kZñ¢nsoâi®$•–Ù9ÀŸ‹^åc:ð8ƒö&Op¢¬…¨¾GEY<Æ®ýÑL=×Ì"4ÒÈø¬´‡¸_ÃG½X–¤OF…úi¢Ê²q³­ZÓ( áÁOV™¨UŠÑŽÕ¡‚‘¡öã&ÚPY­q} ˜ÚÝ\Ð6±¡?r玤æa”åÑ %£u¾,rp4’7ÁmÍÓ‡Ì çJ%{xge�¸Ÿ-~Åz½™/8mëA¨> ÑÐ"ž¼Ðó@YæP;ñ@ì 3h=è¢Ô7þQ6AVTR³ÍTP&ÐXqü袌ÇÍTPyåî‚ë}4§Ec!†v¶PKI°Kµð±ö•Q÷x!tmtc-3/ËuQÑ k£·C¿†Ðx1‰‰Ñºú·¶žp$ï)ÝÆbt…Â6´°­5ßaZù)V1$ǺËDÎCÁ„‚ÛÛÅe¦$·ZBÌ9Ú"-TƒºŠ’P9Ö€YÖ9:¢€O5n ôEõ‘½k܈3iÃÑ¿ED“®—j¡ææ€ÐòDVŸ’¢‚ã\p@ƒ y½PH½UdfЇjª3*²V€´ 3tWv¡Îáfµ˜!±Ðpð¥†Þv33ž\çïºÜb¹6:{­0êÂÈæC}ÔJõ°òƒAÁÕYF]­ËH>6ÑÐí´Qh DŠ-hò@í�IA(†z*((;¹Ì9{ aÑõ(:°­–Ge‡+]õ‹¨ûª£èXÞÖ4u2fn¹‰Ê(¢>Ž &�1ÎЂløæTm$îêÎW9Úé·èƒÂé3…âN¶@/+ÔžZØöàƒæ1-šiC€1üGÖžß*Q^{œMëc}ÔR®ø¨ ¸}_R‚Mp‚oM@T+îH…~�|<Ö+aêŠW®Ôˆ ‘@2¦yÖòSRNº…Pfî@‹‚ °ª„ vZ´ ´J¢ !*-»ìŠëÚ6�®k5¨ík†ZßÕe§,βréàV£5Ífõ²´ÃxÖžßrˆô :hêóQ9ˆù„t@ =§h @ ü " -_r Óg^èŽÌ;ÎprÙ±¸³øª>‡÷;+]cX·µï¿Š#è0“Â-}_nÊ&ć2¨‘FˆmûìƒÄéÙ³5òe$d6ì wñü„?>G4IÖFÝCï-i½RƒÌ9E­ž£H±”eÉi·Š‚M^ŽA7¥*…e½æ@®¶@Y@ƒˆ; yŠ‹©µB´AhÑ íh„„hTID%P4ÔWDN#—Éec®Î[�ú¨ÓšR ÕªÆkG¦[ÄñbéDz>†þ #n¹£r<">y � €´û‘E÷ -´¨jh¡ a€ƒx\ZA±g˜TzXg�stî¤G¯† Œ¢ˆ#ó¢J v×\-Ê×èn··Açâ™”kðïÀ�ƒÁÅÑÌíZFºqPyR»1·¶¥™>*) ÊZ!YTy <Ê€@"‹@Z(´@€@@ $Ñ Ð"UP%P h*+¢'뺋  ÒsysQ¦2VåXÍd5;­2ÞðGld4_ڈп'ÑAá£f€´ v€´ -gš�¨4€T;@í‡?$xy^Hh¯—ùAíá'1Õ½™oQ˜ò(g s•¼jô¤2oìÜO � /3H#( É.‡Ø ð'td<1×\HÓ˹›#À4Ú'"³%EO¢T ùª‚Ô¢‹@ €´ � Ah¨ E$Aj¨DZJ @"@P´VñëÃNå•3 µ>h¬žæ¯ÕTE÷ªÊØH"‰ù êdÄ7p¢72ƒ«€%䍨@ h@  �€@ÐPô@Åw‚ƒxœ,ÐBcƇXsº}›ý¨vâÐ@:³þ;öTtŶdk[Z“VPpâ[/í5àý]ÉæMZ#hÛ:×·‹Í õPy¹šMŸ„¢²$w(¥h Vˆ-@ZÑB�€@  @ZÉ�€@*€T$P„ªQZ´‹ÐZ 3 ¨…&¯Š£2ˆ¶ª:bx½H³ÍDh)Âî¼�Dy¶£f€@ 4€´ Ð @í�€@Ð ‡}è)§ÃA½ è†RÚìönÉ«:"=\$„03™Ðuò÷AêA;i¹ŽRv –¼w=Ô¨ìÌz§Sœ7ÝÀæƒÍÆœCšsHçx¸AÏn<LCû çÛµWîTO±»¬Ý”VzòP$Qh¢ P$Ð @"‹@ˆ€@ZШ-´ H@‘ @ @Üy¨ªx n"´!EgJ¢šz¨Ø.Šˆ æêÐr4  �€@Ð� $ à¨×ƒ| #OÞj¸ÿ�dïæwÉÓ`þ6áûýQÿ�•ß0 æ›ÿ�JüÂQåÉÿ�§>'íAã»bŠÍÈP€;*� h%�€T �€@*@ @• @"@„Uñ@œ;`‚ÇQOø‚ƒ)>!àƒÿÙ��������������������������������������������������������������������������������������������������Plack-1.0039/share/face.jpg�������������������������������������������������������������������������000644 �000765 �000024 �00000005522 12631015706 016311� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÿØÿà�JFIF��H�H��ÿÛ�C�   (1#%(:3=<9387@H\N@DWE78PmQW_bghg>Mqypdx\egcÿÛ�C//cB8BccccccccccccccccccccccccccccccccccccccccccccccccccÿÀ��z�–"�ÿÄ���������������ÿÄ�8� �����!1A"Q2aq#BR‘¡±ÁÑá34br‚’ÿÄ��������������ÿÄ�#���������!1"A2aQÿÚ� ��?�-²¸WšœŠiÈ"ÛMÛS¦â¸ÆÖ¢˜„˜ð�«2¦ƒk·¢LKÕ…!u |Ù væ«Y@%œ¹O¾(–ƒ›>{f”Ý#H+f®ÆÙ#…BŠ–KPËÒ¥ŠX-Ól’'ï§üe¹á]Mrí:,{¦ù‹9¬õÄ3XÍ‘òžÕºgB2:Pm[Êt*cÝW 8ŠQÜŽXn:Œ8®•d`ñœ÷㨡óBèä  RŽòHønk¦ìçj߇¼H[m­ûdôIùÖšñÁx¤‚sšßxS^Žöi+9§þB‚Y¦¥\®Ð!R¥J€�M#Š”ŠiÄDEpŠ~8¦‘HeeŽ6w8UšÃjwMq!cÜÖ£ÄSì )åÏ?jÅHû›š G½5£ðüÈSœf³Ð ?Ü–ÖŠ‘).F+<ãAË‹Õ¤çØšŠ8KÐ;‹=FiÈËȧ6p(þ¥Ý#6ù C޹#ó¬Úý5‹ ZÁ¾ßŽqA¯—32ãšÓéð“aæªë:jÉ™Ñx# Ššua»ÊŒÝíº³"FdÇëvªm}¤©]ã#=ë`tW�ùJ@éôª×š m#\éZ)ŠųäÆßJšÚâH&I¡cˆC+Æ­ßé²Ã܇Žô.#Î+X»0”hö]ÿ�ñ-& ¢�g`;0àÑ Êø]ÚL±dú%ÈüÅj©’*T©P )¦ÓM1ÓH§žµÂ(/â™±'|…þ¿Ú²}Mñt„j_lþŸÝjKDöpµÍìq(ÎMzŸ¢Y“ÕY_À³j¬íÎÅâ½*26Ö3åÑ´x”“ODì3VR%éS¼€- ºº†v<óBƒ“¨”®]Ž›PKW3¨wíš{âíS388ǽ »Š »Ïˆž Ätóœ}€âœ×V’pöñqÎJþuØ´Sk–;AËKˆf@ñ0dq‘Vü¤<ñY¸õH¢\E¨€¥[•›ÒTŇõ¥ð'é†à¥åœrÂêTkͯ­M­ôÑ~Ãd}«~uˆ|¿Óf3ߌŠÊx”F×±\Àêé"•È÷—ñž7䈟(ÒãÇýÒ}Tÿ�:ÙV ÀS²ÝM‡�þêÞÓ0giR¥@€äSH©H¦L’29®O"¹Š�óï±mi×öQE'´-ƒËÔ·óëÍH÷š“Di<èšfû Þ$žšóï>/fˆ÷«s×<ø‘Ñ©¥{å!E}®{ã8¬Ýåó±Û¼‘ïRk—CâÙzÐi˜Ž¼W³‚1ÅþŠL’[ÞµœMYÑ´¯Ää‘¥—lhqéêMO¨hÏ`¾rnhs†ÏUÿ�QsÚ-®¬¦$4àç4ÌbšN+¢È-¥Ö:Ón'ŠxÌ-ì>Ã>õEäÁ¦y†¦Y/€6^Š(Þ Œ¬À°Èÿ�¨ë[ óß\lÖ"Fù\2þx¯B® ©F\³´©R¬Ä "˜EJGÂ*„FG±O"›HF{ÅwÆCEõ¡¬ÈÓäµý‹ê`kÑ]C Cu-(]mxÛl¨0=ˆ ¤ÌF•qð¾ çiüëx²ýkÏ5{v´Ô¤NT«dVžÃRV‰(>¬a‡±®|±ötc~zÛ™uD‰lFmgqkˆX™½).>Ç=éÖú\ŸŽZÜËèäËÈw¢(µY´‰JG¾¾µi©k"Š-"¥¢Í§ß™!kyÄ@nÛ€£w'‹Ë`0Á‰´¼žÚ<#ýC{F½P•õƒö©É‡,È"Àz¥“é÷1úæ6þ”5ßèV±^Ú´3¦å?²7º]´FŠ0?U/¥¾Ì+§«²&Qö•¾]¼çŠl‹$lˆT‘‘žôJãJ¸³òäv£fà«fˆ\Y NÉv2¬Ñü¹©zˆ¹x¾eÆÈ|*†MfÕs€wî½.°¾ ±š-bC4E|”;³Øž•ºªÈí˜3´©R¬É(v®Oé¤U0ÓqRb›ŽhÚá§‘QNÞ\.碌Ð Æ0ŸÄL˜ù”T´kK唺)XÌ¿ØV‚ê_™dà8àak^|ôd;6},IàWWƨÜãìÕ1Qež¼~UavIÆÁ¡‹lÖ»Oë ŽÝöæ7>¤â¼¶Í(ÉxƒM}.ãÌI¶ð`ûP«mM¬î’dÉâ½ýàž¡]¨5×-.l×͵Ú`îò¿â¶Z‰8ì öüe“ÔHȡבZÙ‡I—Ô‡ëíA4Éçd>pbŸªÆŒZÌÀé\í82Õ4q¬Þ- ÉvË¡Þ9á~•WN»_K©àÕÍ[MšþÖÓ2¶9‰›ÒßÚ„YZ\[Ÿ.â6R¼r)B=¹>Ä:=Ãòy¶òíݨ© k5¢<ÑÄÂ-ìÝv®Þ}µ/&LÉ gÖ‚§ê tCêsä^C¤Ôlám²\Æص*˜Åêª~â•Y™ëFº~jF¬‘„SH椮HP^Añ²BiuÀoj¶±³ôÉš T/3¯´pgŸÌ²[Êñ?¥ÔàŠ¬æ¶Z晥l—p2,Øôç€ãÚ±³£Å!ŽUduà«Ezʦ¿MT¬Öè·þmŠÈì2ž†ûŠ«{|dž‚?Ó.ÞI#Êuõ}>´Eá ‘úƒs^V£„ÿ�  ÊÂáÚBw·Ô»ʺmnA¡òƲ:ÒáwÈë\Ô]—þ 7B€{T/d` ç w©m'ÊᎻs6F7PñLT“V¤ nê;Ž´.ÁŽjE“¤ ½iyð×ÑD’c±|ÏíZ-—$a¦ŒgºÇýÍ x4¨Á¶y'oRyk“ûûSôÈîo g»º»†er­²®ßnƒšìŒj',¥l l™ºÝÜþNò©ƒLN¦êðŸˆoéJŠæHzŠv)­ÛïO­LÆâž‘ƒ’ØÀ®§ÍU®ý:}ñ?OúÔ±¢µÍÕíÑÙ§"$] Ä?õ붺,!Ä×n÷sÒœö++ »-柵ˆÞä6Ì1ÐûÖê”t„vwFNÝç _Ú>Õœ×mßTµ•ÓMdžËHìñÕW7ò¢Á‹kl¤’<€{Uöö¤rUž\4û©a’kTycFÚÛ~eïÈëKOÔÚѼ›Œ˜sù§ø­†ý:Ý⎶„=ñÖ‹jvÐKlÍ$1»c«(&µrÞªE)´’Ýe„H˜9ä0ª»ÒÒix}á³.NF�g¥6ïå¯=ªttÅÙ·;XSD¡†Ù>oz€ÓM:—bl0æ¯CùA¡kòÑ›/•j4I(‚%U¶ðÀœ}(}оüJ'+ðÖò®ÑÈ };UÛN‰S_ÿ�¶5ÕÚ92*bø6Çû»þ‡ö¥Vý5û UDQÿÙ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/script/plackup�������������������������������������������������������������������������000755 �000765 �000024 �00000016334 12631015706 016503� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl use strict; use Plack::Runner; my $runner = Plack::Runner->new; $runner->parse_options(@ARGV); $runner->run; __END__ =head1 NAME plackup - Run PSGI application with Plack handlers =head1 SYNOPSIS # read your app from app.psgi file plackup # choose .psgi file from ARGV[0] (or with -a option) plackup hello.psgi # switch server implementation with --server (or -s) plackup --server HTTP::Server::Simple --port 9090 --host 127.0.0.1 test.psgi # use UNIX socket to run FCGI daemon plackup -s FCGI --listen /tmp/fcgi.sock myapp.psgi # launch FCGI external server on port 9090 plackup -s FCGI --port 9090 =head1 DESCRIPTION plackup is a command line utility to run PSGI applications from the command line. plackup automatically figures out the environment it is run in, and runs your application in that environment. FastCGI, CGI, AnyEvent and others can all be detected. See L<Plack::Loader> for the authoritative list. C<plackup> assumes you have an C<app.psgi> script in your current directory. The last statement of C<app.psgi> should be a code reference that is a PSGI application: #!/usr/bin/perl use MyApp; my $application = MyApp->new; my $app = sub { $application->run_psgi(@_) }; =head1 ARGUMENTS =over 4 =item .psgi plackup --host 127.0.0.1 --port 9090 /path/to/app.psgi The first non-option argument is used as a C<.psgi> file path. You can also set this path with C<-a> or C<--app>. If omitted, the default file path is C<app.psgi> in the current directory. =back =head1 OPTIONS =over 4 =item -a, --app Specifies the full path to a C<.psgi> script. You may alternately provide this path as the first argument to C<plackup>. =item -e Evaluates the given perl code as a PSGI app, much like perl's C<-e> option: plackup -e 'sub { my $env = shift; return [ ... ] }' It is also handy when you want to run a custom application like Plack::App::*. plackup -MPlack::App::File -e 'Plack::App::File->new(...)->to_app' You can also specify C<-e> option with C<.psgi> file path to wrap the application with middleware configuration from the command line. You can also use L<Plack::Builder> DSL syntax inside C<-e> code. For example: plackup -e 'enable "Auth::Basic", authenticator => ...;' myapp.psgi is equivalent to the PSGI application: use Plack::Builder; use Plack::Util; builder { enable "Auth::Basic", authenticator => ...; Plack::Util::load_psgi("myapp.psgi"); }; Note that when you use C<-e> option to enable middleware, plackup doesn't assume the implicit C<app.psgi> path. You must either pass the path to your C<.psgi> file in the command line arguments or load the application inside C<-e> after the C<enable>. plackup # Runs app.psgi plackup -e 'enable "Foo"' # Doesn't work! plackup -e 'enable "Foo"' app.psgi # Works plackup -e 'enable "Foo"; sub { ... }' # Works =item -o, --host Binds to a TCP interface. Defaults to undef, which lets most server backends bind to the any (*) interface. This option is only valid for servers which support TCP sockets. =item -p, --port Binds to a TCP port. Defaults to 5000. This option is only valid for servers which support TCP sockets. =item -s, --server, the C<PLACK_SERVER> environment variable Selects a specific server implementation to run on. When provided, the C<-s> or C<--server> flag will be preferred over the environment variable. If no option is given, plackup will try to detect the I<best> server implementation based on the environment variables as well as modules loaded by your application in C<%INC>. See L<Plack::Loader> for details. =item -S, --socket Listens on a UNIX domain socket path. Defaults to undef. This option is only valid for servers which support UNIX sockets. =item -l, --listen Listens on one or more addresses, whether "HOST:PORT", ":PORT", or "PATH" (without colons). You may use this option multiple times to listen on multiple addresses, but the server will decide whether it supports multiple interfaces. =item -D, --daemonize Makes the process run in the background. It's up to the backend server/handler implementation whether this option is respected or not. =item -I Specifies Perl library include paths, like C<perl>'s -I option. You may add multiple paths by using this option multiple times. =item -M Loads the named modules before loading the app's code. You may load multiple modules by using this option multiple times. In combination with C<-r> or C<-R> may not have the desired restart effect when the loaded module is changed in the development directory. To avoid this problem you need to load the module with the app code using C<-e>. =item -E, --env, the C<PLACK_ENV> environment variable. Specifies the environment option. Setting this value with C<-E> or C<--env> also writes to the C<PLACK_ENV> environment variable. This allows applications or frameworks to tell which environment setting the application is running on. # These two are the same plackup -E deployment env PLACK_ENV=deployment plackup Common values are C<development>, C<deployment>, and C<test>. The default value is C<development>, which causes C<plackup> to load the middleware components: I<AccessLog>, I<StackTrace>, and I<Lint> unless C<--no-default-middleware> is set. =item --no-default-middleware This prevents loading the default middleware stack even when Plack environment (i.e. C<-E> or C<PLACK_ENV>) is set to C<development>. =item -r, --reload Makes plackup restart the server whenever a file in your development directory changes. This option by default watches the C<lib> directory and the base directory where I<.psgi> file is located. Use C<-R> to watch other directories. Reloading will delay the compilation of your application. Automatic server detection (see C<-s> above) may not behave as you expect, if plackup needs to scan your application for the modules it uses. Avoid problems by specifying C<-s> explicitly when using C<-r> or C<-R>. To avoid problems with changes to preloaded modules see documentation for C<-M>. =item -R, --Reload Makes plackup restart the server whenever a file in any of the given directories changes. C<-R> and C<--Reload> take a comma-separated list of paths: plackup -R /path/to/project/lib,/path/to/project/templates To avoid problems with changes to preloaded modules see documentation for C<-M>. =item -L, --loader Specifies the server loading subclass that implements how to run the server. Available options are I<Plack::Loader> (default), I<Restarter> (automatically set when C<-r> or C<-R> is used), I<Delayed>, and I<Shotgun>. See L<Plack::Loader::Delayed> and L<Plack::Loader::Shotgun> for more details. =item --access-log Specifies the pathname of a file where the access log should be written. By default, in the development environment access logs will go to STDERR. =item --path Specify the root path of your app (C<SCRIPT_NAME> in PSGI env) to run. The following two commands are roughly the same. plackup --path /foo app.psgi plackup -e 'mount "/foo" => Plack::Util::load_psgi("app.psgi")' =back Other options that starts with C<--> are passed through to the backend server. See each Plack::Handler backend's documentation for more details on their available options. =head1 SEE ALSO L<Plack::Runner> L<Plack::Loader> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/HTTP/������������������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 015130� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/�����������������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 015403� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack.pm���������������������������������������������������������������������������000644 �000765 �000024 �00000014427 12631015706 015751� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack; use strict; use warnings; use 5.008_001; our $VERSION = '1.0039'; 1; __END__ =head1 NAME Plack - Perl Superglue for Web frameworks and Web Servers (PSGI toolkit) =head1 DESCRIPTION Plack is a set of tools for using the PSGI stack. It contains middleware components, a reference server and utilities for Web application frameworks. Plack is like Ruby's Rack or Python's Paste for WSGI. See L<PSGI> for the PSGI specification and L<PSGI::FAQ> to know what PSGI and Plack are and why we need them. =head1 MODULES AND UTILITIES =head2 Plack::Handler L<Plack::Handler> and its subclasses contains adapters for web servers. We have adapters for the built-in standalone web server L<HTTP::Server::PSGI>, L<CGI|Plack::Handler::CGI>, L<FCGI|Plack::Handler::FCGI>, L<Apache1|Plack::Handler::Apache1>, L<Apache2|Plack::Handler::Apache2> and L<HTTP::Server::Simple|Plack::Handler::HTTP::Server::Simple> included in the core Plack distribution. There are also many HTTP server implementations on CPAN that have Plack handlers. See L<Plack::Handler> when writing your own adapters. =head2 Plack::Loader L<Plack::Loader> is a loader to load one L<Plack::Handler> adapter and run a PSGI application code reference with it. =head2 Plack::Util L<Plack::Util> contains a lot of utility functions for server implementors as well as middleware authors. =head2 .psgi files A PSGI application is a code reference but it's not easy to pass code reference via the command line or configuration files, so Plack uses a convention that you need a file named C<app.psgi> or similar, which would be loaded (via perl's core function C<do>) to return the PSGI application code reference. # Hello.psgi my $app = sub { my $env = shift; # ... return [ $status, $headers, $body ]; }; If you use a web framework, chances are that they provide a helper utility to automatically generate these C<.psgi> files for you, such as: # MyApp.psgi use MyApp; my $app = sub { MyApp->run_psgi(@_) }; It's important that the return value of C<.psgi> file is the code reference. See C<eg/dot-psgi> directory for more examples of C<.psgi> files. =head2 plackup, Plack::Runner L<plackup> is a command line launcher to run PSGI applications from command line using L<Plack::Loader> to load PSGI backends. It can be used to run standalone servers and FastCGI daemon processes. Other server backends like Apache2 needs a separate configuration but C<.psgi> application file can still be the same. If you want to write your own frontend that replaces, or adds functionalities to L<plackup>, take a look at the L<Plack::Runner> module. =head2 Plack::Middleware PSGI middleware is a PSGI application that wraps an existing PSGI application and plays both side of application and servers. From the servers the wrapped code reference still looks like and behaves exactly the same as PSGI applications. L<Plack::Middleware> gives you an easy way to wrap PSGI applications with a clean API, and compatibility with L<Plack::Builder> DSL. =head2 Plack::Builder L<Plack::Builder> gives you a DSL that you can enable Middleware in C<.psgi> files to wrap existent PSGI applications. =head2 Plack::Request, Plack::Response L<Plack::Request> gives you a nice wrapper API around PSGI C<$env> hash to get headers, cookies and query parameters much like L<Apache::Request> in mod_perl. L<Plack::Response> does the same to construct the response array reference. =head2 Plack::Test L<Plack::Test> is a unified interface to test your PSGI application using standard L<HTTP::Request> and L<HTTP::Response> pair with simple callbacks. =head2 Plack::Test::Suite L<Plack::Test::Suite> is a test suite to test a new PSGI server backend. =head1 CONTRIBUTING =head2 Patches and Bug Fixes Small patches and bug fixes can be either submitted via nopaste on IRC L<irc://irc.perl.org/#plack> or L<the github issue tracker|http://github.com/plack/Plack/issues>. Forking on L<github|http://github.com/plack/Plack> is another good way if you intend to make larger fixes. See also L<http://contributing.appspot.com/plack> when you think this document is terribly outdated. =head2 Module Namespaces Modules added to the Plack:: sub-namespaces should be reasonably generic components which are useful as building blocks and not just simply using Plack. Middleware authors are free to use the Plack::Middleware:: namespace for their middleware components. Middleware must be written in the pipeline style such that they can chained together with other middleware components. The Plack::Middleware:: modules in the core distribution are good examples of such modules. It is recommended that you inherit from L<Plack::Middleware> for these types of modules. Not all middleware components are wrappers, but instead are more like endpoints in a middleware chain. These types of components should use the Plack::App:: namespace. Again, look in the core modules to see excellent examples of these (L<Plack::App::File>, L<Plack::App::Directory>, etc.). It is recommended that you inherit from L<Plack::Component> for these types of modules. B<DO NOT USE> Plack:: namespace to build a new web application or a framework. It's like naming your application under CGI:: namespace if it's supposed to run on CGI and that is a really bad choice and would confuse people badly. =head1 AUTHOR Tatsuhiko Miyagawa =head1 COPYRIGHT The following copyright notice applies to all the files provided in this distribution, including binary files, unless explicitly noted otherwise. Copyright 2009-2013 Tatsuhiko Miyagawa =head1 CORE DEVELOPERS Tatsuhiko Miyagawa (miyagawa) Tokuhiro Matsuno (tokuhirom) Jesse Luehrs (doy) Tomas Doran (bobtfish) Graham Knop (haarg) =head1 CONTRIBUTORS Yuval Kogman (nothingmuch) Kazuhiro Osawa (Yappo) Kazuho Oku Florian Ragwitz (rafl) Chia-liang Kao (clkao) Masahiro Honma (hiratara) Daisuke Murase (typester) John Beppu Matt S Trout (mst) Shawn M Moore (Sartak) Stevan Little Hans Dieter Pearcey (confound) mala Mark Stosberg Aaron Trevena =head1 SEE ALSO The L<PSGI> specification upon which Plack is based. L<http://plackperl.org/> The Plack wiki: L<https://github.com/plack/Plack/wiki> The Plack FAQ: L<https://github.com/plack/Plack/wiki/Faq> =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/App/�������������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 016123� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Builder.pm�������������������������������������������������������������������000644 �000765 �000024 �00000020526 12631015706 017334� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Builder; use strict; use parent qw( Exporter ); our @EXPORT = qw( builder add enable enable_if mount ); use Carp (); use Plack::App::URLMap; use Plack::Middleware::Conditional; # TODO delayed load? use Scalar::Util (); sub new { my $class = shift; bless { middlewares => [ ] }, $class; } sub add_middleware { my($self, $mw, @args) = @_; if (ref $mw ne 'CODE') { my $mw_class = Plack::Util::load_class($mw, 'Plack::Middleware'); $mw = sub { $mw_class->wrap($_[0], @args) }; } push @{$self->{middlewares}}, $mw; } sub add_middleware_if { my($self, $cond, $mw, @args) = @_; if (ref $mw ne 'CODE') { my $mw_class = Plack::Util::load_class($mw, 'Plack::Middleware'); $mw = sub { $mw_class->wrap($_[0], @args) }; } push @{$self->{middlewares}}, sub { Plack::Middleware::Conditional->wrap($_[0], condition => $cond, builder => $mw); }; } # do you want remove_middleware() etc.? sub _mount { my ($self, $location, $app) = @_; if (!$self->{_urlmap}) { $self->{_urlmap} = Plack::App::URLMap->new; } $self->{_urlmap}->map($location => $app); $self->{_urlmap}; # for backward compat. } sub to_app { my($self, $app) = @_; if ($app) { $self->wrap($app); } elsif ($self->{_urlmap}) { $self->{_urlmap} = $self->{_urlmap}->to_app if Scalar::Util::blessed($self->{_urlmap}); $self->wrap($self->{_urlmap}); } else { Carp::croak("to_app() is called without mount(). No application to build."); } } sub wrap { my($self, $app) = @_; if ($self->{_urlmap} && $app ne $self->{_urlmap}) { Carp::carp("WARNING: wrap() and mount() can't be used altogether in Plack::Builder.\n" . "WARNING: This causes all previous mount() mappings to be ignored."); } for my $mw (reverse @{$self->{middlewares}}) { $app = $mw->($app); } $app; } # DSL goes here our $_add = our $_add_if = our $_mount = sub { Carp::croak("enable/mount should be called inside builder {} block"); }; sub enable { $_add->(@_) } sub enable_if(&$@) { $_add_if->(@_) } sub mount { my $self = shift; if (Scalar::Util::blessed($self)) { $self->_mount(@_); }else{ $_mount->($self, @_); } } sub builder(&) { my $block = shift; my $self = __PACKAGE__->new; my $mount_is_called; my $urlmap = Plack::App::URLMap->new; local $_mount = sub { $mount_is_called++; $urlmap->map(@_); $urlmap; }; local $_add = sub { $self->add_middleware(@_); }; local $_add_if = sub { $self->add_middleware_if(@_); }; my $app = $block->(); if ($mount_is_called) { if ($app ne $urlmap) { Carp::carp("WARNING: You used mount() in a builder block, but the last line (app) isn't using mount().\n" . "WARNING: This causes all mount() mappings to be ignored.\n"); } else { $app = $app->to_app; } } $app = $app->to_app if $app and Scalar::Util::blessed($app) and $app->can('to_app'); $self->to_app($app); } 1; __END__ =head1 NAME Plack::Builder - OO and DSL to enable Plack Middlewares =head1 SYNOPSIS # in .psgi use Plack::Builder; my $app = sub { ... }; builder { enable "Deflater"; enable "Session", store => "File"; enable "Debug", panels => [ qw(DBITrace Memory Timer) ]; enable "+My::Plack::Middleware"; $app; }; # use URLMap builder { mount "/foo" => builder { enable "Foo"; $app; }; mount "/bar" => $app2; mount "http://example.com/" => builder { $app3 }; }; # using OO interface my $builder = Plack::Builder->new; $builder->add_middleware('Foo', opt => 1); $builder->add_middleware('Bar'); $builder->wrap($app); =head1 DESCRIPTION Plack::Builder gives you a quick domain specific language (DSL) to wrap your application with L<Plack::Middleware> subclasses. The middleware you're trying to use should use L<Plack::Middleware> as a base class to use this DSL, inspired by Rack::Builder. Whenever you call C<enable> on any middleware, the middleware app is pushed to the stack inside the builder, and then reversed when it actually creates a wrapped application handler. C<"Plack::Middleware::"> is added as a prefix by default. So: builder { enable "Foo"; enable "Bar", opt => "val"; $app; }; is syntactically equal to: $app = Plack::Middleware::Bar->wrap($app, opt => "val"); $app = Plack::Middleware::Foo->wrap($app); In other words, you're supposed to C<enable> middleware from outer to inner. =head1 INLINE MIDDLEWARE Plack::Builder allows you to code middleware inline using a nested code reference. If the first argument to C<enable> is a code reference, it will be passed an C<$app> and should return another code reference which is a PSGI application that consumes C<$env> at runtime. So: builder { enable sub { my $app = shift; sub { my $env = shift; # do preprocessing my $res = $app->($env); # do postprocessing return $res; }; }; $app; }; is equal to: my $mw = sub { my $app = shift; sub { my $env = shift; $app->($env) }; }; $app = $mw->($app); =head1 URLMap support Plack::Builder has a native support for L<Plack::App::URLMap> via the C<mount> method. use Plack::Builder; my $app = builder { mount "/foo" => $app1; mount "/bar" => builder { enable "Foo"; $app2; }; }; See L<Plack::App::URLMap>'s C<map> method to see what they mean. With C<builder> you can't use C<map> as a DSL, for the obvious reason :) B<NOTE>: Once you use C<mount> in your builder code, you have to use C<mount> for all the paths, including the root path (C</>). You can't have the default app in the last line of C<builder> like: my $app = sub { my $env = shift; ... }; builder { mount "/foo" => sub { ... }; $app; # THIS DOESN'T WORK }; You'll get warnings saying that your mount configuration will be ignored. Instead you should use C<< mount "/" => ... >> in the last line to set the default fallback app. builder { mount "/foo" => sub { ... }; mount "/" => $app; } Note that the C<builder> DSL returns a whole new PSGI application, which means =over 4 =item * C<builder { ... }> should normally the last statement of a C<.psgi> file, because the return value of C<builder> is the application that is actually executed. =item * You can nest your C<builder> blocks, mixed with C<mount> statements (see L</"URLMap support"> above): builder { mount "/foo" => builder { mount "/bar" => $app; } } will locate the C<$app> under C</foo/bar>, since the inner C<builder> block puts it under C</bar> and it results in a new PSGI application which is located under C</foo> because of the outer C<builder> block. =back =head1 CONDITIONAL MIDDLEWARE SUPPORT You can use C<enable_if> to conditionally enable middleware based on the runtime environment. builder { enable_if { $_[0]->{REMOTE_ADDR} eq '127.0.0.1' } 'StackTrace', force => 1; $app; }; See L<Plack::Middleware::Conditional> for details. =head1 OBJECT ORIENTED INTERFACE Object oriented interface supports the same functionality with the DSL version in a clearer interface, probably with more typing required. # With mount my $builder = Plack::Builder->new; $builder->add_middleware('Foo', opt => 1); $builder->mount('/foo' => $foo_app); $builder->mount('/' => $root_app); $builder->to_app; # Nested builders. Equivalent to: # builder { # mount '/foo' => builder { # enable 'Foo'; # $app; # }; # mount '/' => $app2; # }; my $builder_out = Plack::Builder->new; my $builder_in = Plack::Builder->new; $builder_in->add_middleware('Foo'); $builder_out->mount("/foo" => $builder_in->wrap($app)); $builder_out->mount("/" => $app2); $builder_out->to_app; # conditional. You can also directly use Plack::Middleware::Conditional my $builder = Plack::Builder->new; $builder->add_middleware_if(sub { $_[0]->{REMOTE_ADDR} eq '127.0.0.1' }, 'StackTrace'); $builder->wrap($app); =head1 SEE ALSO L<Plack::Middleware> L<Plack::App::URLMap> L<Plack::Middleware::Conditional> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Component.pm�����������������������������������������������������������������000644 �000765 �000024 �00000010226 12631015706 017704� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Component; use strict; use warnings; use Carp (); use Plack::Util; use overload '&{}' => \&to_app_auto, fallback => 1; sub new { my $proto = shift; my $class = ref $proto || $proto; my $self; if (@_ == 1 && ref $_[0] eq 'HASH') { $self = bless {%{$_[0]}}, $class; } else { $self = bless {@_}, $class; } $self; } sub to_app_auto { my $self = shift; if (($ENV{PLACK_ENV} || '') eq 'development') { my $class = ref($self); warn "WARNING: Automatically converting $class instance to a PSGI code reference. " . "If you see this warning for each request, you probably need to explicitly call " . "to_app() i.e. $class->new(...)->to_app in your PSGI file.\n"; } $self->to_app(@_); } # NOTE: # this is for back-compat only, # future modules should use # Plack::Util::Accessor directly # or their own favorite accessor # generator. # - SL sub mk_accessors { my $self = shift; Plack::Util::Accessor::mk_accessors( ref( $self ) || $self, @_ ) } sub prepare_app { return } sub to_app { my $self = shift; $self->prepare_app; return sub { $self->call(@_) }; } sub response_cb { my($self, $res, $cb) = @_; Plack::Util::response_cb($res, $cb); } 1; __END__ =head1 NAME Plack::Component - Base class for PSGI endpoints =head1 SYNOPSIS package Plack::App::Foo; use parent qw( Plack::Component ); sub call { my($self, $env) = @_; # Do something with $env my $res = ...; # create a response ... # return the response return $res; } =head1 DESCRIPTION Plack::Component is the base class shared between L<Plack::Middleware> and C<Plack::App::*> modules. If you are writing middleware, you should inherit from L<Plack::Middleware>, but if you are writing a Plack::App::* you should inherit from this directly. =head1 REQUIRED METHOD =over 4 =item call ($env) You are expected to implement a C<call> method in your component. This is where all the work gets done. It receives the PSGI C<$env> hash-ref as an argument and is expected to return a proper PSGI response value. =back =head1 METHODS =over 4 =item new (%opts | \%opts) The constructor accepts either a hash or a hashref and uses that to create the instance. It will call no other methods and simply return the instance that is created. =item prepare_app This method is called by C<to_app> and is meant as a hook to be used to prepare your component before it is packaged as a PSGI C<$app>. =item to_app This is the method used in several parts of the Plack infrastructure to convert your component into a PSGI C<$app>. You should not ever need to override this method; it is recommended to use C<prepare_app> and C<call> instead. =item response_cb This is a wrapper for C<response_cb> in L<Plack::Util>. See L<Plack::Middleware/RESPONSE CALLBACK> for details. =back =head1 OBJECT LIFECYCLE Objects for the derived classes (Plack::App::* or Plack::Middleware::*) are created at the PSGI application compile phase using C<new>, C<prepare_app> and C<to_app>, and the created object persists during the web server lifecycle, unless it is running on the non-persistent environment like CGI. C<call> is invoked against the same object whenever a new request comes in. You can check if it is running in a persistent environment by checking C<psgi.run_once> key in the C<$env> being true (non-persistent) or false (persistent), but it is best for you to write your middleware safely for a persistent environment. To accomplish that, you should avoid saving per-request data like C<$env> in your object. =head1 BACKWARDS COMPATIBILITY The L<Plack::Middleware> module used to inherit from L<Class::Accessor::Fast>, which has been removed in favor of the L<Plack::Util::Accessor> module. When developing new components it is recommended to use L<Plack::Util::Accessor> like so: use Plack::Util::Accessor qw( foo bar baz ); However, in order to keep backwards compatibility this module provides a C<mk_accessors> method similar to L<Class::Accessor::Fast>. New code should not use this and use L<Plack::Util::Accessor> instead. =head1 SEE ALSO L<Plack> L<Plack::Builder> L<Plack::Middleware> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/���������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 016760� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler.pm�������������������������������������������������������������������000644 �000765 �000024 �00000003656 12631015706 017330� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler; use strict; 1; __END__ =head1 NAME Plack::Handler - Connects PSGI applications and Web servers =head1 SYNOPSIS package Plack::Handler::AwesomeWebServer; sub new { my($class, %opt) = @_; ... return $self; } sub run { my($self, $app) = @_; # launch the AwesomeWebServer and run $app in the loop } # then from command line plackup -s AwesomeWebServer -a app.psgi =head1 DESCRIPTION Plack::Handler defines an adapter (connector) interface to adapt L<plackup> and L<Plack::Runner> to various PSGI web servers, such as Apache2 for mod_perl and Standalone for L<HTTP::Server::PSGI>. It is an empty class, and as long as they implement the methods defined as an Server adapter interface, they do not need to inherit Plack::Handler. If you write a new handler for existing web servers, I recommend you to include the full name of the server module after I<Plack::Handler> prefix, like L<Plack::Handler::Net::Server::Coro> if you write a handler for L<Net::Server::Coro>. That way you'll be using plackup command line option like: plackup -s Net::Server::Coro that makes it easy to figure out which web server you're going to use. =head1 METHODS =over 4 =item new $server = FooBarServer->new(%args); Creates a new adapter object. I<%args> can take arbitrary parameters to configure server environments but common parameters are: =over 8 =item port Port number the server listens to. =item host Address the server listens to. Set to undef to listen any interface. =back =item run $server->run($app); Starts the server process and when a request comes in, run the PSGI application passed in C<$app> in the loop. =item register_service $server->register_service($app); Optional interface if your server should run in parallel with other event loop, particularly L<AnyEvent>. This is the same as C<run> but doesn't run the main loop. =back =head1 SEE ALSO rackup =cut ����������������������������������������������������������������������������������Plack-1.0039/lib/Plack/HTTPParser/������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 017337� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/HTTPParser.pm����������������������������������������������������������������000644 �000765 �000024 �00000002015 12631015706 017673� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::HTTPParser; use strict; use parent qw(Exporter); our @EXPORT = qw( parse_http_request ); use Try::Tiny; { if (!$ENV{PLACK_HTTP_PARSER_PP} && try { require HTTP::Parser::XS; 1 }) { *parse_http_request = \&HTTP::Parser::XS::parse_http_request; } else { require Plack::HTTPParser::PP; *parse_http_request = \&Plack::HTTPParser::PP::parse_http_request; } } 1; __END__ =head1 NAME Plack::HTTPParser - Parse HTTP headers =head1 SYNOPSIS use Plack::HTTPParser qw(parse_http_request); my $ret = parse_http_request($header_str, \%env); # see HTTP::Parser::XS docs =head1 DESCRIPTION Plack::HTTPParser is a wrapper class to dispatch C<parse_http_request> to Kazuho Oku's XS based HTTP::Parser::XS or pure perl fallback based on David Robins HTTP::Parser. If you want to force the use of the slower pure perl version even if the fast XS version is available, set the environment variable C<PLACK_HTTP_PARSER_PP> to 1. =head1 SEE ALSO L<HTTP::Parser::XS> L<HTTP::Parser> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Loader/����������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 016611� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Loader.pm��������������������������������������������������������������������000644 �000765 �000024 �00000005755 12631015706 017163� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Loader; use strict; use Carp (); use Plack::Util; use Try::Tiny; sub new { my $class = shift; bless {}, $class; } sub watch { # do nothing. Override in subclass } sub auto { my($class, @args) = @_; my $backend = $class->guess or Carp::croak("Couldn't auto-guess server server implementation. Set it with PLACK_SERVER"); my $server = try { $class->load($backend, @args); } catch { if (($ENV{PLACK_ENV}||'') eq 'development' or !/^Can't locate /) { warn "Autoloading '$backend' backend failed. Falling back to the Standalone. ", "(You might need to install Plack::Handler::$backend from CPAN. Caught error was: $_)\n" if $ENV{PLACK_ENV} && $ENV{PLACK_ENV} eq 'development'; } $class->load('Standalone' => @args); }; return $server; } sub load { my($class, $server, @args) = @_; my($server_class, $error); try { $server_class = Plack::Util::load_class($server, 'Plack::Handler'); } catch { $error ||= $_; }; if ($server_class) { $server_class->new(@args); } else { die $error; } } sub preload_app { my($self, $builder) = @_; $self->{app} = $builder->(); } sub guess { my $class = shift; my $env = $class->env; return $env->{PLACK_SERVER} if $env->{PLACK_SERVER}; if ($env->{PHP_FCGI_CHILDREN} || $env->{FCGI_ROLE} || $env->{FCGI_SOCKET_PATH}) { return "FCGI"; } elsif ($env->{GATEWAY_INTERFACE}) { return "CGI"; } elsif (exists $INC{"Coro.pm"}) { return "Corona"; } elsif (exists $INC{"AnyEvent.pm"}) { return "Twiggy"; } elsif (exists $INC{"POE.pm"}) { return "POE"; } else { return "Standalone"; } } sub env { \%ENV } sub run { my($self, $server, $builder) = @_; $server->run($self->{app}); } 1; __END__ =head1 NAME Plack::Loader - (auto)load Plack Servers =head1 SYNOPSIS # auto-select server backends based on env vars use Plack::Loader; Plack::Loader->auto(%args)->run($app); # specify the implementation with a name Plack::Loader->load('FCGI', %args)->run($app); =head1 DESCRIPTION Plack::Loader is a factory class to load one of Plack::Handler subclasses based on the environment. =head1 AUTOLOADING C<< Plack::Loader->auto(%args) >> will autoload the most correct server implementation by guessing from environment variables and Perl INC hashes. =over 4 =item PLACK_SERVER env PLACK_SERVER=AnyEvent ... Plack users can specify the specific implementation they want to load using the C<PLACK_SERVER> environment variable. =item PHP_FCGI_CHILDREN, GATEWAY_INTERFACE If there's one of FastCGI or CGI specific environment variables set, use the corresponding server implementation. =item %INC If one of L<AnyEvent>, L<Coro> or L<POE> is loaded, the relevant server implementation such as L<Twiggy>, L<Corona> or L<POE::Component::Server::PSGI> will be loaded, if they're available. =back =cut �������������������Plack-1.0039/lib/Plack/LWPish.pm��������������������������������������������������������������������000644 �000765 �000024 �00000003210 12631015706 017103� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::LWPish; use strict; use warnings; use HTTP::Tiny; use HTTP::Response; use Hash::MultiValue; sub new { my $class = shift; my $self = bless {}, $class; $self->{http} = @_ == 1 ? $_[0] : HTTP::Tiny->new(@_); $self; } sub request { my($self, $req) = @_; my @headers; $req->headers->scan(sub { push @headers, @_ }); my $options = { headers => Hash::MultiValue->new(@headers)->mixed, }; $options->{content} = $req->content if defined $req->content && length($req->content); my $response = $self->{http}->request($req->method, $req->url, $options); my $res = HTTP::Response->new( $response->{status}, $response->{reason}, [ Hash::MultiValue->from_mixed($response->{headers})->flatten ], $response->{content}, ); $res->request($req); return $res; } 1; __END__ =head1 NAME Plack::LWPish - HTTP::Request/Response compatible interface with HTTP::Tiny backend =head1 SYNOPSIS use Plack::LWPish; my $request = HTTP::Request->new(GET => 'http://perl.com/'); my $ua = Plack::LWPish->new; my $res = $ua->request($request); # returns HTTP::Response =head1 DESCRIPTION This module is an adapter object that implements one method, C<request> that acts like L<LWP::UserAgent>'s request method i.e. takes HTTP::Request object and returns HTTP::Response object. This module is used solely inside L<Plack::Test::Suite> and L<Plack::Test::Server>, and you are recommended to take a look at L<HTTP::Thin> if you would like to use this outside Plack. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<HTTP::Thin> L<HTTP::Tiny> L<LWP::UserAgent> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 017460� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware.pm����������������������������������������������������������������000644 �000765 �000024 �00000012662 12631015706 020025� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware; use strict; use warnings; use Carp (); use parent qw(Plack::Component); use Plack::Util; use Plack::Util::Accessor qw( app ); sub wrap { my($self, $app, @args) = @_; if (ref $self) { $self->{app} = $app; } else { $self = $self->new({ app => $app, @args }); } return $self->to_app; } 1; __END__ =head1 NAME Plack::Middleware - Base class for easy-to-use PSGI middleware =head1 SYNOPSIS package Plack::Middleware::Foo; use parent qw( Plack::Middleware ); sub call { my($self, $env) = @_; # Do something with $env # $self->app is the original app my $res = $self->app->($env); # Do something with $res return $res; } # then in app.psgi use Plack::Builder; my $app = sub { ... } # as usual builder { enable "Plack::Middleware::Foo"; enable "Plack::Middleware::Bar", %options; $app; }; =head1 DESCRIPTION Plack::Middleware is a utility base class to write PSGI middleware. All you have to do is to inherit from Plack::Middleware and then implement the callback C<call> method (or the C<to_app> method that would return the PSGI code reference) to do the actual work. You can use C<< $self->app >> to call the original (wrapped) application. Your middleware object is created at the PSGI application compile time and is persistent during the web server life cycle (unless it is a non-persistent environment such as CGI), so you should never set or cache per-request data like C<$env> in your middleware object. See also L<Plack::Component/"OBJECT LIFECYCLE">. See L<Plack::Builder> how to actually enable middleware in your I<.psgi> application file using the DSL. If you do not like our builder DSL, you can also use the C<wrap> method to wrap your application with a middleware: use Plack::Middleware::Foo; my $app = sub { ... }; $app = Plack::Middleware::Foo->wrap($app, %options); $app = Plack::Middleware::Bar->wrap($app, %options); =head1 RESPONSE CALLBACK The typical middleware is written like this: package Plack::Middleware::Something; use parent qw(Plack::Middleware); sub call { my($self, $env) = @_; # pre-processing $env my $res = $self->app->($env); # post-processing $res return $res; } The tricky thing about post-processing the response is that it could either be an immediate 3 element array ref, or a code reference that implements the delayed (streaming) interface. Dealing with these two types of response in each piece of middleware is pointless, so you're recommended to use the C<response_cb> wrapper function in L<Plack::Util> when implementing a post processing middleware. sub call { my($self, $env) = @_; # pre-processing $env my $res = $app->($env); return Plack::Util::response_cb($res, sub { my $res = shift; # do something with $res; }); } The callback function gets a response as an array reference, and you can update the reference to implement the post-processing. In the normal case, this arrayref will have three elements (as described by the PSGI spec), but will have only two elements when using a C<$writer> as described below. package Plack::Middleware::Always500; use parent qw(Plack::Middleware); use Plack::Util; sub call { my($self, $env) = @_; my $res = $self->app->($env); return Plack::Util::response_cb($res, sub { my $res = shift; $res->[0] = 500; return; }); } In this example, the callback gets the C<$res> and updates its first element (status code) to 500. Using C<response_cb> makes sure that this works with the delayed response too. You're not required (and not recommended either) to return a new array reference - they will be simply ignored. You're suggested to explicitly return, unless you fiddle with the content filter callback (see below). Similarly, note that you have to keep the C<$res> reference when you swap the entire response. Plack::Util::response_cb($res, sub { my $res = shift; $res = [ $new_status, $new_headers, $new_body ]; # THIS DOES NOT WORK return; }); This does not work, since assigning a new anonymous array to C<$res> doesn't update the original PSGI response value. You should instead do: Plack::Util::response_cb($res, sub { my $res = shift; @$res = ($new_status, $new_headers, $new_body); # THIS WORKS return; }); The third element of the response array ref is a body, and it could be either an arrayref or L<IO::Handle>-ish object. The application could also make use of the C<$writer> object if C<psgi.streaming> is in effect, and in this case, the third element will not exist (C<@$res == 2>). Dealing with these variants is again really painful, and C<response_cb> can take care of that too, by allowing you to return a content filter as a code reference. # replace all "Foo" in content body with "Bar" Plack::Util::response_cb($res, sub { my $res = shift; return sub { my $chunk = shift; return unless defined $chunk; $chunk =~ s/Foo/Bar/g; return $chunk; } }); The callback takes one argument C<$chunk> and your callback is expected to return the updated chunk. If the given C<$chunk> is undef, it means the stream has reached the end, so your callback should also return undef, or return the final chunk and return undef when called next time. =head1 SEE ALSO L<Plack> L<Plack::Builder> L<Plack::Component> =cut ������������������������������������������������������������������������������Plack-1.0039/lib/Plack/MIME.pm����������������������������������������������������������������������000644 �000765 �000024 �00000017013 12631015706 016472� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::MIME; use strict; # stolen from rack.mime.rb our $MIME_TYPES = { ".3gp" => "video/3gpp", ".a" => "application/octet-stream", ".ai" => "application/postscript", ".aif" => "audio/x-aiff", ".aiff" => "audio/x-aiff", ".apk" => "application/vnd.android.package-archive", ".asc" => "application/pgp-signature", ".asf" => "video/x-ms-asf", ".asm" => "text/x-asm", ".asx" => "video/x-ms-asf", ".atom" => "application/atom+xml", ".au" => "audio/basic", ".avi" => "video/x-msvideo", ".bat" => "application/x-msdownload", ".bin" => "application/octet-stream", ".bmp" => "image/bmp", ".bz2" => "application/x-bzip2", ".c" => "text/x-c", ".cab" => "application/vnd.ms-cab-compressed", ".cc" => "text/x-c", ".chm" => "application/vnd.ms-htmlhelp", ".class" => "application/octet-stream", ".com" => "application/x-msdownload", ".conf" => "text/plain", ".cpp" => "text/x-c", ".crt" => "application/x-x509-ca-cert", ".css" => "text/css", ".csv" => "text/csv", ".cxx" => "text/x-c", ".deb" => "application/x-debian-package", ".der" => "application/x-x509-ca-cert", ".diff" => "text/x-diff", ".djv" => "image/vnd.djvu", ".djvu" => "image/vnd.djvu", ".dll" => "application/x-msdownload", ".dmg" => "application/octet-stream", ".doc" => "application/msword", ".dot" => "application/msword", ".dtd" => "application/xml-dtd", ".dvi" => "application/x-dvi", ".ear" => "application/java-archive", ".eml" => "message/rfc822", ".eps" => "application/postscript", ".exe" => "application/x-msdownload", ".f" => "text/x-fortran", ".f77" => "text/x-fortran", ".f90" => "text/x-fortran", ".flv" => "video/x-flv", ".for" => "text/x-fortran", ".gem" => "application/octet-stream", ".gemspec" => "text/x-script.ruby", ".gif" => "image/gif", ".gz" => "application/x-gzip", ".h" => "text/x-c", ".hh" => "text/x-c", ".htm" => "text/html", ".html" => "text/html", ".ico" => "image/vnd.microsoft.icon", ".ics" => "text/calendar", ".ifb" => "text/calendar", ".iso" => "application/octet-stream", ".jar" => "application/java-archive", ".java" => "text/x-java-source", ".jnlp" => "application/x-java-jnlp-file", ".jpeg" => "image/jpeg", ".jpg" => "image/jpeg", ".js" => "application/javascript", ".json" => "application/json", ".log" => "text/plain", ".m3u" => "audio/x-mpegurl", ".m4v" => "video/mp4", ".man" => "text/troff", ".manifest"=> "text/cache-manifest", ".mathml" => "application/mathml+xml", ".mbox" => "application/mbox", ".mdoc" => "text/troff", ".me" => "text/troff", ".mid" => "audio/midi", ".midi" => "audio/midi", ".mime" => "message/rfc822", ".mml" => "application/mathml+xml", ".mng" => "video/x-mng", ".mov" => "video/quicktime", ".mp3" => "audio/mpeg", ".mp4" => "video/mp4", ".mp4v" => "video/mp4", ".mpeg" => "video/mpeg", ".mpg" => "video/mpeg", ".ms" => "text/troff", ".msi" => "application/x-msdownload", ".odp" => "application/vnd.oasis.opendocument.presentation", ".ods" => "application/vnd.oasis.opendocument.spreadsheet", ".odt" => "application/vnd.oasis.opendocument.text", ".ogg" => "application/ogg", ".ogv" => "video/ogg", ".p" => "text/x-pascal", ".pas" => "text/x-pascal", ".pbm" => "image/x-portable-bitmap", ".pdf" => "application/pdf", ".pem" => "application/x-x509-ca-cert", ".pgm" => "image/x-portable-graymap", ".pgp" => "application/pgp-encrypted", ".pkg" => "application/octet-stream", ".pl" => "text/x-script.perl", ".pm" => "text/x-script.perl-module", ".png" => "image/png", ".pnm" => "image/x-portable-anymap", ".ppm" => "image/x-portable-pixmap", ".pps" => "application/vnd.ms-powerpoint", ".ppt" => "application/vnd.ms-powerpoint", ".ps" => "application/postscript", ".psd" => "image/vnd.adobe.photoshop", ".py" => "text/x-script.python", ".qt" => "video/quicktime", ".ra" => "audio/x-pn-realaudio", ".rake" => "text/x-script.ruby", ".ram" => "audio/x-pn-realaudio", ".rar" => "application/x-rar-compressed", ".rb" => "text/x-script.ruby", ".rdf" => "application/rdf+xml", ".roff" => "text/troff", ".rpm" => "application/x-redhat-package-manager", ".rss" => "application/rss+xml", ".rtf" => "application/rtf", ".ru" => "text/x-script.ruby", ".s" => "text/x-asm", ".sgm" => "text/sgml", ".sgml" => "text/sgml", ".sh" => "application/x-sh", ".sig" => "application/pgp-signature", ".snd" => "audio/basic", ".so" => "application/octet-stream", ".svg" => "image/svg+xml", ".svgz" => "image/svg+xml", ".swf" => "application/x-shockwave-flash", ".t" => "text/troff", ".tar" => "application/x-tar", ".tbz" => "application/x-bzip-compressed-tar", ".tcl" => "application/x-tcl", ".tex" => "application/x-tex", ".texi" => "application/x-texinfo", ".texinfo" => "application/x-texinfo", ".text" => "text/plain", ".tif" => "image/tiff", ".tiff" => "image/tiff", ".torrent" => "application/x-bittorrent", ".tr" => "text/troff", ".txt" => "text/plain", ".vcf" => "text/x-vcard", ".vcs" => "text/x-vcalendar", ".vrml" => "model/vrml", ".war" => "application/java-archive", ".wav" => "audio/x-wav", ".webm" => "video/webm", ".wma" => "audio/x-ms-wma", ".wmv" => "video/x-ms-wmv", ".wmx" => "video/x-ms-wmx", ".woff" => "application/font-woff", ".wrl" => "model/vrml", ".wsdl" => "application/wsdl+xml", ".xbm" => "image/x-xbitmap", ".xhtml" => "application/xhtml+xml", ".xls" => "application/vnd.ms-excel", ".xml" => "application/xml", ".xpm" => "image/x-xpixmap", ".xsl" => "application/xml", ".xslt" => "application/xslt+xml", ".yaml" => "text/yaml", ".yml" => "text/yaml", ".zip" => "application/zip", }; my $fallback = sub { }; sub mime_type { my($class, $file) = @_; $file =~ /(\.[a-zA-Z0-9]+)$/ or return; $MIME_TYPES->{lc $1} || $fallback->(lc $1); } sub add_type { my $class = shift; while (my($ext, $type) = splice @_, 0, 2) { $MIME_TYPES->{lc $ext} = $type; } } sub set_fallback { my($class, $cb) = @_; $fallback = $cb; } 1; __END__ =head1 NAME Plack::MIME - MIME type registry =head1 SYNOPSIS use Plack::MIME; my $mime = Plack::MIME->mime_type(".png"); # image/png # register new type(s) Plack::MIME->add_type(".foo" => "application/x-foo"); # Use MIME::Types as a fallback use MIME::Types 'by_suffix'; Plack::MIME->set_fallback(sub { (by_suffix $_[0])[0] }); =head1 DESCRIPTION Plack::MIME is a simple MIME type registry for Plack applications. The selection of MIME types is based on Rack's Rack::Mime module. =head1 SEE ALSO Rack::Mime L<MIME::Types> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Request/���������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 017033� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Request.pm�������������������������������������������������������������������000644 �000765 �000024 �00000046462 12631015706 017405� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Request; use strict; use warnings; use 5.008_001; our $VERSION = '1.0039'; use HTTP::Headers::Fast; use Carp (); use Hash::MultiValue; use HTTP::Body; use Plack::Request::Upload; use Stream::Buffered; use URI; use URI::Escape (); sub new { my($class, $env) = @_; Carp::croak(q{$env is required}) unless defined $env && ref($env) eq 'HASH'; bless { env => $env }, $class; } sub env { $_[0]->{env} } sub address { $_[0]->env->{REMOTE_ADDR} } sub remote_host { $_[0]->env->{REMOTE_HOST} } sub protocol { $_[0]->env->{SERVER_PROTOCOL} } sub method { $_[0]->env->{REQUEST_METHOD} } sub port { $_[0]->env->{SERVER_PORT} } sub user { $_[0]->env->{REMOTE_USER} } sub request_uri { $_[0]->env->{REQUEST_URI} } sub path_info { $_[0]->env->{PATH_INFO} } sub path { $_[0]->env->{PATH_INFO} || '/' } sub query_string{ $_[0]->env->{QUERY_STRING} } sub script_name { $_[0]->env->{SCRIPT_NAME} } sub scheme { $_[0]->env->{'psgi.url_scheme'} } sub secure { $_[0]->scheme eq 'https' } sub body { $_[0]->env->{'psgi.input'} } sub input { $_[0]->env->{'psgi.input'} } sub content_length { $_[0]->env->{CONTENT_LENGTH} } sub content_type { $_[0]->env->{CONTENT_TYPE} } sub session { $_[0]->env->{'psgix.session'} } sub session_options { $_[0]->env->{'psgix.session.options'} } sub logger { $_[0]->env->{'psgix.logger'} } sub cookies { my $self = shift; return {} unless $self->env->{HTTP_COOKIE}; # HTTP_COOKIE hasn't changed: reuse the parsed cookie if ( $self->env->{'plack.cookie.parsed'} && $self->env->{'plack.cookie.string'} eq $self->env->{HTTP_COOKIE}) { return $self->env->{'plack.cookie.parsed'}; } $self->env->{'plack.cookie.string'} = $self->env->{HTTP_COOKIE}; my %results; my @pairs = grep m/=/, split "[;,] ?", $self->env->{'plack.cookie.string'}; for my $pair ( @pairs ) { # trim leading trailing whitespace $pair =~ s/^\s+//; $pair =~ s/\s+$//; my ($key, $value) = map URI::Escape::uri_unescape($_), split( "=", $pair, 2 ); # Take the first one like CGI.pm or rack do $results{$key} = $value unless exists $results{$key}; } $self->env->{'plack.cookie.parsed'} = \%results; } sub query_parameters { my $self = shift; $self->env->{'plack.request.query'} ||= $self->_parse_query; } sub _parse_query { my $self = shift; my @query; my $query_string = $self->env->{QUERY_STRING}; if (defined $query_string) { $query_string =~ s/\A[&;]+//; @query = map { s/\+/ /g; URI::Escape::uri_unescape($_) } map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]+/, $query_string); } Hash::MultiValue->new(@query); } sub content { my $self = shift; unless ($self->env->{'psgix.input.buffered'}) { $self->_parse_request_body; } my $fh = $self->input or return ''; my $cl = $self->env->{CONTENT_LENGTH} or return ''; $fh->seek(0, 0); # just in case middleware/apps read it without seeking back $fh->read(my($content), $cl, 0); $fh->seek(0, 0); return $content; } sub raw_body { $_[0]->content } # XXX you can mutate headers with ->headers but it's not written through to the env sub headers { my $self = shift; if (!defined $self->{headers}) { my $env = $self->env; $self->{headers} = HTTP::Headers::Fast->new( map { (my $field = $_) =~ s/^HTTPS?_//; ( $field => $env->{$_} ); } grep { /^(?:HTTP|CONTENT)/i } keys %$env ); } $self->{headers}; } sub content_encoding { shift->headers->content_encoding(@_) } sub header { shift->headers->header(@_) } sub referer { shift->headers->referer(@_) } sub user_agent { shift->headers->user_agent(@_) } sub body_parameters { my $self = shift; unless ($self->env->{'plack.request.body'}) { $self->_parse_request_body; } return $self->env->{'plack.request.body'}; } # contains body + query sub parameters { my $self = shift; $self->env->{'plack.request.merged'} ||= do { my $query = $self->query_parameters; my $body = $self->body_parameters; Hash::MultiValue->new($query->flatten, $body->flatten); }; } sub uploads { my $self = shift; if ($self->env->{'plack.request.upload'}) { return $self->env->{'plack.request.upload'}; } $self->_parse_request_body; return $self->env->{'plack.request.upload'}; } sub param { my $self = shift; return keys %{ $self->parameters } if @_ == 0; my $key = shift; return $self->parameters->{$key} unless wantarray; return $self->parameters->get_all($key); } sub upload { my $self = shift; return keys %{ $self->uploads } if @_ == 0; my $key = shift; return $self->uploads->{$key} unless wantarray; return $self->uploads->get_all($key); } sub uri { my $self = shift; my $base = $self->_uri_base; # We have to escape back PATH_INFO in case they include stuff like # ? or # so that the URI parser won't be tricked. However we should # preserve '/' since encoding them into %2f doesn't make sense. # This means when a request like /foo%2fbar comes in, we recognize # it as /foo/bar which is not ideal, but that's how the PSGI PATH_INFO # spec goes and we can't do anything about it. See PSGI::FAQ for details. # See RFC 3986 before modifying. my $path_escape_class = q{^/;:@&=A-Za-z0-9\$_.+!*'(),-}; my $path = URI::Escape::uri_escape($self->env->{PATH_INFO} || '', $path_escape_class); $path .= '?' . $self->env->{QUERY_STRING} if defined $self->env->{QUERY_STRING} && $self->env->{QUERY_STRING} ne ''; $base =~ s!/$!! if $path =~ m!^/!; return URI->new($base . $path)->canonical; } sub base { my $self = shift; URI->new($self->_uri_base)->canonical; } sub _uri_base { my $self = shift; my $env = $self->env; my $uri = ($env->{'psgi.url_scheme'} || "http") . "://" . ($env->{HTTP_HOST} || (($env->{SERVER_NAME} || "") . ":" . ($env->{SERVER_PORT} || 80))) . ($env->{SCRIPT_NAME} || '/'); return $uri; } sub new_response { my $self = shift; require Plack::Response; Plack::Response->new(@_); } sub _parse_request_body { my $self = shift; my $ct = $self->env->{CONTENT_TYPE}; my $cl = $self->env->{CONTENT_LENGTH}; if (!$ct && !$cl) { # No Content-Type nor Content-Length -> GET/HEAD $self->env->{'plack.request.body'} = Hash::MultiValue->new; $self->env->{'plack.request.upload'} = Hash::MultiValue->new; return; } my $body = HTTP::Body->new($ct, $cl); # HTTP::Body will create temporary files in case there was an # upload. Those temporary files can be cleaned up by telling # HTTP::Body to do so. It will run the cleanup when the request # env is destroyed. That the object will not go out of scope by # the end of this sub we will store a reference here. $self->env->{'plack.request.http.body'} = $body; $body->cleanup(1); my $input = $self->input; my $buffer; if ($self->env->{'psgix.input.buffered'}) { # Just in case if input is read by middleware/apps beforehand $input->seek(0, 0); } else { $buffer = Stream::Buffered->new($cl); } my $spin = 0; while ($cl) { $input->read(my $chunk, $cl < 8192 ? $cl : 8192); my $read = length $chunk; $cl -= $read; $body->add($chunk); $buffer->print($chunk) if $buffer; if ($read == 0 && $spin++ > 2000) { Carp::croak "Bad Content-Length: maybe client disconnect? ($cl bytes remaining)"; } } if ($buffer) { $self->env->{'psgix.input.buffered'} = 1; $self->env->{'psgi.input'} = $buffer->rewind; } else { $input->seek(0, 0); } $self->env->{'plack.request.body'} = Hash::MultiValue->from_mixed($body->param); my @uploads = Hash::MultiValue->from_mixed($body->upload)->flatten; my @obj; while (my($k, $v) = splice @uploads, 0, 2) { push @obj, $k, $self->_make_upload($v); } $self->env->{'plack.request.upload'} = Hash::MultiValue->new(@obj); 1; } sub _make_upload { my($self, $upload) = @_; my %copy = %$upload; $copy{headers} = HTTP::Headers::Fast->new(%{$upload->{headers}}); Plack::Request::Upload->new(%copy); } 1; __END__ =head1 NAME Plack::Request - Portable HTTP request object from PSGI env hash =head1 SYNOPSIS use Plack::Request; my $app_or_middleware = sub { my $env = shift; # PSGI env my $req = Plack::Request->new($env); my $path_info = $req->path_info; my $query = $req->parameters->{query}; my $res = $req->new_response(200); # new Plack::Response $res->finalize; }; =head1 DESCRIPTION L<Plack::Request> provides a consistent API for request objects across web server environments. =head1 CAVEAT Note that this module is intended to be used by Plack middleware developers and web application framework developers rather than application developers (end users). Writing your web application directly using Plack::Request is certainly possible but not recommended: it's like doing so with mod_perl's Apache::Request: yet too low level. If you're writing a web application, not a framework, then you're encouraged to use one of the web application frameworks that support PSGI (L<http://plackperl.org/#frameworks>), or see modules like L<HTTP::Engine> to provide higher level Request and Response API on top of PSGI. =head1 METHODS Some of the methods defined in the earlier versions are deprecated in version 0.99. Take a look at L</"INCOMPATIBILITIES">. Unless otherwise noted, all methods and attributes are B<read-only>, and passing values to the method like an accessor doesn't work like you expect it to. =head2 new Plack::Request->new( $env ); Creates a new request object. =head1 ATTRIBUTES =over 4 =item env Returns the shared PSGI environment hash reference. This is a reference, so writing to this environment passes through during the whole PSGI request/response cycle. =item address Returns the IP address of the client (C<REMOTE_ADDR>). =item remote_host Returns the remote host (C<REMOTE_HOST>) of the client. It may be empty, in which case you have to get the IP address using C<address> method and resolve on your own. =item method Contains the request method (C<GET>, C<POST>, C<HEAD>, etc). =item protocol Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request. =item request_uri Returns the raw, undecoded request URI path. You probably do B<NOT> want to use this to dispatch requests. =item path_info Returns B<PATH_INFO> in the environment. Use this to get the local path for the requests. =item path Similar to C<path_info> but returns C</> in case it is empty. In other words, it returns the virtual path of the request URI after C<< $req->base >>. See L</"DISPATCHING"> for details. =item query_string Returns B<QUERY_STRING> in the environment. This is the undecoded query string in the request URI. =item script_name Returns B<SCRIPT_NAME> in the environment. This is the absolute path where your application is hosted. =item scheme Returns the scheme (C<http> or C<https>) of the request. =item secure Returns true or false, indicating whether the connection is secure (https). =item body, input Returns C<psgi.input> handle. =item session Returns (optional) C<psgix.session> hash. When it exists, you can retrieve and store per-session data from and to this hash. =item session_options Returns (optional) C<psgix.session.options> hash. =item logger Returns (optional) C<psgix.logger> code reference. When it exists, your application is supposed to send the log message to this logger, using: $req->logger->({ level => 'debug', message => "This is a debug message" }); =item cookies Returns a reference to a hash containing the cookies. Values are strings that are sent by clients and are URI decoded. If there are multiple cookies with the same name in the request, this method will ignore the duplicates and return only the first value. If that causes issues for you, you may have to use modules like CGI::Simple::Cookie to parse C<< $request->header('Cookies') >> by yourself. =item query_parameters Returns a reference to a hash containing query string (GET) parameters. This hash reference is L<Hash::MultiValue> object. =item body_parameters Returns a reference to a hash containing posted parameters in the request body (POST). As with C<query_parameters>, the hash reference is a L<Hash::MultiValue> object. =item parameters Returns a L<Hash::MultiValue> hash reference containing (merged) GET and POST parameters. =item content, raw_body Returns the request content in an undecoded byte string for POST requests. =item uri Returns an URI object for the current request. The URI is constructed using various environment values such as C<SCRIPT_NAME>, C<PATH_INFO>, C<QUERY_STRING>, C<HTTP_HOST>, C<SERVER_NAME> and C<SERVER_PORT>. Every time this method is called it returns a new, cloned URI object. =item base Returns an URI object for the base path of current request. This is like C<uri> but only contains up to C<SCRIPT_NAME> where your application is hosted at. Every time this method is called it returns a new, cloned URI object. =item user Returns C<REMOTE_USER> if it's set. =item headers Returns an L<HTTP::Headers::Fast> object containing the headers for the current request. =item uploads Returns a reference to a hash containing uploads. The hash reference is a L<Hash::MultiValue> object and values are L<Plack::Request::Upload> objects. =item content_encoding Shortcut to $req->headers->content_encoding. =item content_length Shortcut to $req->headers->content_length. =item content_type Shortcut to $req->headers->content_type. =item header Shortcut to $req->headers->header. =item referer Shortcut to $req->headers->referer. =item user_agent Shortcut to $req->headers->user_agent. =item param Returns GET and POST parameters with a CGI.pm-compatible param method. This is an alternative method for accessing parameters in $req->parameters just in case you want the compatibility with CGI.pm objects. You are B<not recommended> to use this method since it is easy to misuse in a list context such as inside a hash constructor or method arguments. Use C<parameters> and Hash::MultiValue instead. Unlike CGI.pm, it does I<not> allow setting or modifying query parameters. $value = $req->param( 'foo' ); @values = $req->param( 'foo' ); @params = $req->param; =item upload A convenient method to access $req->uploads. $upload = $req->upload('field'); @uploads = $req->upload('field'); @fields = $req->upload; for my $upload ( $req->upload('field') ) { print $upload->filename; } =item new_response my $res = $req->new_response; Creates a new L<Plack::Response> object. Handy to remove dependency on L<Plack::Response> in your code for easy subclassing and duck typing in web application frameworks, as well as overriding Response generation in middlewares. =back =head2 Hash::MultiValue parameters Parameters that can take one or multiple values (i.e. C<parameters>, C<query_parameters>, C<body_parameters> and C<uploads>) store the hash reference as a L<Hash::MultiValue> object. This means you can use the hash reference as a plain hash where values are B<always> scalars (B<NOT> array references), so you don't need to code ugly and unsafe C<< ref ... eq 'ARRAY' >> anymore. And if you explicitly want to get multiple values of the same key, you can call the C<get_all> method on it, such as: my @foo = $req->query_parameters->get_all('foo'); You can also call C<get_one> to always get one parameter independent of the context (unlike C<param>), and even call C<mixed> (with Hash::MultiValue 0.05 or later) to get the I<traditional> hash reference, my $params = $req->parameters->mixed; where values are either a scalar or an array reference depending on input, so it might be useful if you already have the code to deal with that ugliness. =head2 PARSING POST BODY and MULTIPLE OBJECTS The methods to parse request body (C<content>, C<body_parameters> and C<uploads>) are carefully coded to save the parsed body in the environment hash as well as in the temporary buffer, so you can call them multiple times and create Plack::Request objects multiple times in a request and they should work safely, and won't parse request body more than twice for the efficiency. =head1 DISPATCHING If your application or framework wants to dispatch (or route) actions based on request paths, be sure to use C<< $req->path_info >> not C<< $req->uri->path >>. This is because C<path_info> gives you the virtual path of the request, regardless of how your application is mounted. If your application is hosted with mod_perl or CGI scripts, or even multiplexed with tools like L<Plack::App::URLMap>, request's C<path_info> always gives you the action path. Note that C<path_info> might give you an empty string, in which case you should assume that the path is C</>. You will also want to use C<< $req->base >> as a base prefix when building URLs in your templates or in redirections. It's a good idea for you to subclass Plack::Request and define methods such as: sub uri_for { my($self, $path, $args) = @_; my $uri = $self->base; $uri->path($uri->path . $path); $uri->query_form(@$args) if $args; $uri; } So you can say: my $link = $req->uri_for('/logout', [ signoff => 1 ]); and if C<< $req->base >> is C</app> you'll get the full URI for C</app/logout?signoff=1>. =head1 INCOMPATIBILITIES In version 0.99, many utility methods are removed or deprecated, and most methods are made read-only. These methods were deleted in version 1.0001. All parameter-related methods such as C<parameters>, C<body_parameters>, C<query_parameters> and C<uploads> now contains L<Hash::MultiValue> objects, rather than I<scalar or an array reference depending on the user input> which is insecure. See L<Hash::MultiValue> for more about this change. C<< $req->path >> method had a bug, where the code and the document was mismatching. The document was suggesting it returns the sub request path after C<< $req->base >> but the code was always returning the absolute URI path. The code is now updated to be an alias of C<< $req->path_info >> but returns C</> in case it's empty. If you need the older behavior, just call C<< $req->uri->path >> instead. Cookie handling is simplified, and doesn't use L<CGI::Simple::Cookie> anymore, which means you B<CAN NOT> set array reference or hash reference as a cookie value and expect it be serialized. You're always required to set string value, and encoding or decoding them is totally up to your application or framework. Also, C<cookies> hash reference now returns I<strings> for the cookies rather than CGI::Simple::Cookie objects, which means you no longer have to write a wacky code such as: $v = $req->cookies->{foo} ? $req->cookies->{foo}->value : undef; and instead, simply do: $v = $req->cookies->{foo}; =head1 AUTHORS Tatsuhiko Miyagawa Kazuhiro Osawa Tokuhiro Matsuno =head1 SEE ALSO L<Plack::Response> L<HTTP::Request>, L<Catalyst::Request> =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Response.pm������������������������������������������������������������������000644 �000765 �000024 �00000014221 12631015706 017537� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Response; use strict; use warnings; our $VERSION = '1.0039'; use Plack::Util::Accessor qw(body status); use Carp (); use Cookie::Baker (); use Scalar::Util (); use HTTP::Headers::Fast; use URI::Escape (); sub code { shift->status(@_) } sub content { shift->body(@_) } sub new { my($class, $rc, $headers, $content) = @_; my $self = bless {}, $class; $self->status($rc) if defined $rc; $self->headers($headers) if defined $headers; $self->body($content) if defined $content; $self; } sub headers { my $self = shift; if (@_) { my $headers = shift; if (ref $headers eq 'ARRAY') { Carp::carp("Odd number of headers") if @$headers % 2 != 0; $headers = HTTP::Headers::Fast->new(@$headers); } elsif (ref $headers eq 'HASH') { $headers = HTTP::Headers::Fast->new(%$headers); } return $self->{headers} = $headers; } else { return $self->{headers} ||= HTTP::Headers::Fast->new(); } } sub cookies { my $self = shift; if (@_) { $self->{cookies} = shift; } else { return $self->{cookies} ||= +{ }; } } sub header { shift->headers->header(@_) } # shortcut sub content_length { shift->headers->content_length(@_); } sub content_type { shift->headers->content_type(@_); } sub content_encoding { shift->headers->content_encoding(@_); } sub location { my $self = shift; return $self->headers->header('Location' => @_); } sub redirect { my $self = shift; if (@_) { my $url = shift; my $status = shift || 302; $self->location($url); $self->status($status); } return $self->location; } sub finalize { my $self = shift; Carp::croak "missing status" unless $self->status(); my $headers = $self->headers; my @headers; $headers->scan(sub{ my ($k,$v) = @_; $v =~ s/\015\012[\040|\011]+/chr(32)/ge; # replace LWS with a single SP $v =~ s/\015|\012//g; # remove CR and LF since the char is invalid here push @headers, $k, $v; }); $self->_finalize_cookies(\@headers); return [ $self->status, \@headers, $self->_body, ]; } sub to_app { my $self = shift; return sub { $self->finalize }; } sub _body { my $self = shift; my $body = $self->body; $body = [] unless defined $body; if (!ref $body or Scalar::Util::blessed($body) && overload::Method($body, q("")) && !$body->can('getline')) { return [ $body ]; } else { return $body; } } sub _finalize_cookies { my($self, $headers) = @_; foreach my $name ( keys %{ $self->cookies } ) { my $val = $self->cookies->{$name}; my $cookie = Cookie::Baker::bake_cookie( $name, $val ); push @$headers, 'Set-Cookie' => $cookie; } } 1; __END__ =head1 NAME Plack::Response - Portable HTTP Response object for PSGI response =head1 SYNOPSIS use Plack::Response; sub psgi_handler { my $env = shift; my $res = Plack::Response->new(200); $res->content_type('text/html'); $res->body("Hello World"); return $res->finalize; } =head1 DESCRIPTION Plack::Response allows you a way to create PSGI response array ref through a simple API. =head1 METHODS =over 4 =item new $res = Plack::Response->new; $res = Plack::Response->new($status); $res = Plack::Response->new($status, $headers); $res = Plack::Response->new($status, $headers, $body); Creates a new Plack::Response object. =item status $res->status(200); $status = $res->status; Sets and gets HTTP status code. C<code> is an alias. =item headers $headers = $res->headers; $res->headers([ 'Content-Type' => 'text/html' ]); $res->headers({ 'Content-Type' => 'text/html' }); $res->headers( HTTP::Headers::Fast->new ); Sets and gets HTTP headers of the response. Setter can take either an array ref, a hash ref or L<HTTP::Headers::Fast> object containing a list of headers. =item body $res->body($body_str); $res->body([ "Hello", "World" ]); $res->body($io); Gets and sets HTTP response body. Setter can take either a string, an array ref, or an IO::Handle-like object. C<content> is an alias. Note that this method doesn't automatically set I<Content-Length> for the response. You have to set it manually if you want, with the C<content_length> method (see below). =item header $res->header('X-Foo' => 'bar'); my $val = $res->header('X-Foo'); Shortcut for C<< $res->headers->header >>. =item content_type, content_length, content_encoding $res->content_type('text/plain'); $res->content_length(123); $res->content_encoding('gzip'); Shortcut for the equivalent get/set methods in C<< $res->headers >>. =item redirect $res->redirect($url); $res->redirect($url, 301); Sets redirect URL with an optional status code, which defaults to 302. Note that this method doesn't normalize the given URI string. Users of this module have to be responsible about properly encoding URI paths and parameters. =item location Gets and sets C<Location> header. Note that this method doesn't normalize the given URI string in the setter. See above in C<redirect> for details. =item cookies $res->cookies->{foo} = 123; $res->cookies->{foo} = { value => '123' }; Returns a hash reference containing cookies to be set in the response. The keys of the hash are the cookies' names, and their corresponding values are a plain string (for C<value> with everything else defaults) or a hash reference that can contain keys such as C<value>, C<domain>, C<expires>, C<path>, C<httponly>, C<secure>, C<max-age>. C<expires> can take a string or an integer (as an epoch time) and B<does not> convert string formats such as C<+3M>. $res->cookies->{foo} = { value => 'test', path => "/", domain => '.example.com', expires => time + 24 * 60 * 60, }; =item finalize $res->finalize; Returns the status code, headers, and body of this response as a PSGI response array reference. =item to_app $app = $res->to_app; A helper shortcut for C<< sub { $res->finalize } >>. =back =head1 AUTHOR Tokuhiro Matsuno Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::Request> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Runner.pm��������������������������������������������������������������������000644 �000765 �000024 �00000020740 12631015706 017215� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Runner; use strict; use warnings; use Carp (); use Plack::Util; use Try::Tiny; sub new { my $class = shift; bless { env => $ENV{PLACK_ENV}, loader => 'Plack::Loader', includes => [], modules => [], default_middleware => 1, @_, }, $class; } # delay the build process for reloader sub build(&;$) { my $block = shift; my $app = shift || sub { }; return sub { $block->($app->()) }; } sub parse_options { my $self = shift; local @ARGV = @_; # From 'prove': Allow cuddling the paths with -I, -M and -e @ARGV = map { /^(-[IMe])(.+)/ ? ($1,$2) : $_ } @ARGV; my($host, $port, $socket, @listen); require Getopt::Long; my $parser = Getopt::Long::Parser->new( config => [ "no_auto_abbrev", "no_ignore_case", "pass_through" ], ); $parser->getoptions( "a|app=s" => \$self->{app}, "o|host=s" => \$host, "p|port=i" => \$port, "s|server=s" => \$self->{server}, "S|socket=s" => \$socket, 'l|listen=s@' => \@listen, 'D|daemonize' => \$self->{daemonize}, "E|env=s" => \$self->{env}, "e=s" => \$self->{eval}, 'I=s@' => $self->{includes}, 'M=s@' => $self->{modules}, 'r|reload' => sub { $self->{loader} = "Restarter" }, 'R|Reload=s' => sub { $self->{loader} = "Restarter"; $self->loader->watch(split ",", $_[1]) }, 'L|loader=s' => \$self->{loader}, "access-log=s" => \$self->{access_log}, "path=s" => \$self->{path}, "h|help" => \$self->{help}, "v|version" => \$self->{version}, "default-middleware!" => \$self->{default_middleware}, ); my(@options, @argv); while (defined(my $arg = shift @ARGV)) { if ($arg =~ s/^--?//) { my @v = split '=', $arg, 2; $v[0] =~ tr/-/_/; if (@v == 2) { push @options, @v; } elsif ($v[0] =~ s/^(disable|enable)_//) { push @options, $v[0], $1 eq 'enable'; } else { push @options, $v[0], shift @ARGV; } } else { push @argv, $arg; } } push @options, $self->mangle_host_port_socket($host, $port, $socket, @listen); push @options, daemonize => 1 if $self->{daemonize}; $self->{options} = \@options; $self->{argv} = \@argv; } sub set_options { my $self = shift; push @{$self->{options}}, @_; } sub mangle_host_port_socket { my($self, $host, $port, $socket, @listen) = @_; for my $listen (reverse @listen) { if ($listen =~ /:\d+$/) { ($host, $port) = split /:/, $listen, 2; $host = undef if $host eq ''; } else { $socket ||= $listen; } } unless (@listen) { if ($socket) { @listen = ($socket); } else { $port ||= 5000; @listen = ($host ? "$host:$port" : ":$port"); } } return host => $host, port => $port, listen => \@listen, socket => $socket; } sub version_cb { my $self = shift; $self->{version_cb} || sub { require Plack; print "Plack $Plack::VERSION\n"; }; } sub setup { my $self = shift; if ($self->{help}) { require Pod::Usage; Pod::Usage::pod2usage(0); } if ($self->{version}) { $self->version_cb->(); exit; } if (@{$self->{includes}}) { require lib; lib->import(@{$self->{includes}}); } if ($self->{eval}) { push @{$self->{modules}}, 'Plack::Builder'; } for (@{$self->{modules}}) { my($module, @import) = split /[=,]/; eval "require $module" or die $@; $module->import(@import); } } sub locate_app { my($self, @args) = @_; my $psgi = $self->{app} || $args[0]; if (ref $psgi eq 'CODE') { return sub { $psgi }; } if ($self->{eval}) { $self->loader->watch("lib"); return build { no strict; no warnings; my $eval = "builder { $self->{eval};"; $eval .= "Plack::Util::load_psgi(\$psgi);" if $psgi; $eval .= "}"; eval $eval or die $@; }; } $psgi ||= "app.psgi"; require File::Basename; $self->loader->watch( File::Basename::dirname($psgi) . "/lib", $psgi ); build { Plack::Util::load_psgi $psgi }; } sub watch { my($self, @dir) = @_; push @{$self->{watch}}, @dir if $self->{loader} eq 'Restarter'; } sub apply_middleware { my($self, $app, $class, @args) = @_; my $mw_class = Plack::Util::load_class($class, 'Plack::Middleware'); build { $mw_class->wrap($_[0], @args) } $app; } sub prepare_devel { my($self, $app) = @_; if ($self->{default_middleware}) { $app = $self->apply_middleware($app, 'Lint'); $app = $self->apply_middleware($app, 'StackTrace'); if (!$ENV{GATEWAY_INTERFACE} and !$self->{access_log}) { $app = $self->apply_middleware($app, 'AccessLog'); } } push @{$self->{options}}, server_ready => sub { my($args) = @_; my $name = $args->{server_software} || ref($args); # $args is $server my $host = $args->{host} || 0; my $proto = $args->{proto} || 'http'; print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; }; $app; } sub loader { my $self = shift; $self->{_loader} ||= Plack::Util::load_class($self->{loader}, 'Plack::Loader')->new; } sub load_server { my($self, $loader) = @_; if ($self->{server}) { return $loader->load($self->{server}, @{$self->{options}}); } else { return $loader->auto(@{$self->{options}}); } } sub run { my $self = shift; unless (ref $self) { $self = $self->new; $self->parse_options(@_); return $self->run; } unless ($self->{options}) { $self->parse_options(); } my @args = @_ ? @_ : @{$self->{argv}}; $self->setup; my $app = $self->locate_app(@args); if ($self->{path}) { require Plack::App::URLMap; $app = build { my $urlmap = Plack::App::URLMap->new; $urlmap->mount($self->{path} => $_[0]); $urlmap->to_app; } $app; } $ENV{PLACK_ENV} ||= $self->{env} || 'development'; if ($ENV{PLACK_ENV} eq 'development') { $app = $self->prepare_devel($app); } if ($self->{access_log}) { open my $logfh, ">>", $self->{access_log} or die "open($self->{access_log}): $!"; $logfh->autoflush(1); $app = $self->apply_middleware($app, 'AccessLog', logger => sub { $logfh->print( @_ ) }); } my $loader = $self->loader; $loader->preload_app($app); my $server = $self->load_server($loader); $loader->run($server); } 1; __END__ =head1 NAME Plack::Runner - plackup core =head1 SYNOPSIS # Your bootstrap script use Plack::Runner; my $app = sub { ... }; my $runner = Plack::Runner->new; $runner->parse_options(@ARGV); $runner->run($app); =head1 DESCRIPTION Plack::Runner is the core of L<plackup> runner script. You can create your own frontend to run your application or framework, munge command line options and pass that to C<run> method of this class. C<run> method does exactly the same thing as the L<plackup> script does, but one notable addition is that you can pass a PSGI application code reference directly to the method, rather than via C<.psgi> file path or with C<-e> switch. This would be useful if you want to make an installable PSGI application. Also, when C<-h> or C<--help> switch is passed, the usage text is automatically extracted from your own script using L<Pod::Usage>. =head1 NOTES Do not directly call this module from your C<.psgi>, since that makes your PSGI application unnecessarily depend on L<plackup> and won't run other backends like L<Plack::Handler::Apache2> or mod_psgi. If you I<really> want to make your C<.psgi> runnable as a standalone script, you can do this: my $app = sub { ... }; unless (caller) { require Plack::Runner; my $runner = Plack::Runner->new; $runner->parse_options(@ARGV); $runner->run($app); exit 0; } return $app; B<WARNING>: this section used to recommend C<if (__FILE__ eq $0)> but it's known to be broken since Plack 0.9971, since C<$0> is now I<always> set to the .psgi file path even when you run it from plackup. =head1 SEE ALSO L<plackup> =cut ��������������������������������Plack-1.0039/lib/Plack/TempBuffer.pm����������������������������������������������������������������000644 �000765 �000024 �00000000735 12631015706 020005� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::TempBuffer; use strict; use warnings; use parent 'Stream::Buffered'; sub new { my $class = shift; if (defined $Plack::TempBuffer::MaxMemoryBufferSize) { warn "Setting \$Plack::TempBuffer::MaxMemoryBufferSize is deprecated. " . "You should set \$Stream::Buffered::MaxMemoryBufferSize instead."; $Stream::Buffered::MaxMemoryBufferSize = $Plack::TempBuffer::MaxMemoryBufferSize; } return $class->SUPER::new(@_); } 1; �����������������������������������Plack-1.0039/lib/Plack/Test/������������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 016322� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Test.pm����������������������������������������������������������������������000644 �000765 �000024 �00000011300 12631015706 016653� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Test; use strict; use warnings; use Carp; use parent qw(Exporter); our @EXPORT = qw(test_psgi); our $Impl; $Impl ||= $ENV{PLACK_TEST_IMPL} || "MockHTTP"; sub create { my($class, $app, @args) = @_; my $subclass = "Plack::Test::$Impl"; eval "require $subclass"; die $@ if $@; no strict 'refs'; if (defined &{"Plack::Test::$Impl\::test_psgi"}) { return \&{"Plack::Test::$Impl\::test_psgi"}; } $subclass->new($app, @args); } sub test_psgi { if (ref $_[0] && @_ == 2) { @_ = (app => $_[0], client => $_[1]); } my %args = @_; my $app = delete $args{app}; # Backward compat: some implementations don't need app my $client = delete $args{client} or Carp::croak "client test code needed"; my $tester = Plack::Test->create($app, %args); return $tester->(@_) if ref $tester eq 'CODE'; # compatibility $client->(sub { $tester->request(@_) }); } 1; __END__ =head1 NAME Plack::Test - Test PSGI applications with various backends =head1 SYNOPSIS use Plack::Test; use HTTP::Request::Common; # Simple OO interface my $app = sub { return [ 200, [], [ "Hello "] ] }; my $test = Plack::Test->create($app); my $res = $test->request(GET "/"); is $res->content, "Hello"; # traditional - named params test_psgi app => sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello World" ] ], }, client => sub { my $cb = shift; my $req = HTTP::Request->new(GET => "http://localhost/hello"); my $res = $cb->($req); like $res->content, qr/Hello World/; }; # positional params (app, client) my $app = sub { return [ 200, [], [ "Hello "] ] }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/"); is $res->content, "Hello"; }; =head1 DESCRIPTION Plack::Test is a unified interface to test PSGI applications using L<HTTP::Request> and L<HTTP::Response> objects. It also allows you to run PSGI applications in various ways. The default backend is C<Plack::Test::MockHTTP>, but you may also use any L<Plack::Handler> implementation to run live HTTP requests against a web server. =head1 METHODS =over 4 =item create $test = Plack::Test->create($app, %options); creates an instance of Plack::Test implementation class. C<$app> has to be a valid PSGI application code reference. =item request $res = $test->request($request); takes an HTTP::Request object, runs it through the PSGI application to test and returns an HTTP::Response object. =back =head1 FUNCTIONS Plack::Test also provides a functional interface that takes two callbacks, each of which represents PSGI application and HTTP client code that tests the application. =over 4 =item test_psgi test_psgi $app, $client; test_psgi app => $app, client => $client; Runs the client test code C<$client> against a PSGI application C<$app>. The client callback gets one argument C<$cb>, a callback that accepts an C<HTTP::Request> object and returns an C<HTTP::Response> object. Use L<HTTP::Request::Common> to import shortcuts for creating requests for C<GET>, C<POST>, C<DELETE>, and C<PUT> operations. For your convenience, the C<HTTP::Request> given to the callback automatically uses the HTTP protocol and the localhost (I<127.0.0.1> by default), so the following code just works: use HTTP::Request::Common; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/hello"); }; Note that however, it is not a good idea to pass an arbitrary (i.e. user-input) string to C<GET> or even C<< HTTP::Request->new >> by assuming that it always represents a path, because: my $req = GET "//foo/bar"; would represent a request for a URL that has no scheme, has a hostname I<foo> and a path I</bar>, instead of a path I<//foo/bar> which you might actually want. =back =head1 OPTIONS Specify the L<Plack::Test> backend using the environment variable C<PLACK_TEST_IMPL> or C<$Plack::Test::Impl> package variable. The available values for the backend are: =over 4 =item MockHTTP (Default) Creates a PSGI env hash out of HTTP::Request object, runs the PSGI application in-process and returns HTTP::Response. =item Server Runs one of Plack::Handler backends (C<Standalone> by default) and sends live HTTP requests to test. =item ExternalServer Runs tests against an external server specified in the C<PLACK_TEST_EXTERNALSERVER_URI> environment variable instead of spawning the application in a server locally. =back For instance, test your application with the C<HTTP::Server::ServerSimple> server backend with: > env PLACK_TEST_IMPL=Server PLACK_SERVER=HTTP::Server::ServerSimple \ prove -l t/test.t =head1 AUTHOR Tatsuhiko Miyagawa =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Util/������������������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 016320� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Util.pm����������������������������������������������������������������������000644 �000765 �000024 �00000036713 12631015706 016670� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Util; use strict; use Carp (); use Scalar::Util; use IO::Handle; use overload (); use File::Spec (); sub TRUE() { 1==1 } sub FALSE() { !TRUE } # there does not seem to be a relevant RT or perldelta entry for this use constant _SPLICE_SAME_ARRAY_SEGFAULT => $] < '5.008007'; sub load_class { my($class, $prefix) = @_; if ($prefix) { unless ($class =~ s/^\+// || $class =~ /^$prefix/) { $class = "$prefix\::$class"; } } my $file = $class; $file =~ s!::!/!g; require "$file.pm"; ## no critic return $class; } sub is_real_fh ($) { my $fh = shift; { no warnings 'uninitialized'; return FALSE if -p $fh or -c _ or -b _; } my $reftype = Scalar::Util::reftype($fh) or return; if ( $reftype eq 'IO' or $reftype eq 'GLOB' && *{$fh}{IO} ) { # if it's a blessed glob make sure to not break encapsulation with # fileno($fh) (e.g. if you are filtering output then file descriptor # based operations might no longer be valid). # then ensure that the fileno *opcode* agrees too, that there is a # valid IO object inside $fh either directly or indirectly and that it # corresponds to a real file descriptor. my $m_fileno = $fh->fileno; return FALSE unless defined $m_fileno; return FALSE unless $m_fileno >= 0; my $f_fileno = fileno($fh); return FALSE unless defined $f_fileno; return FALSE unless $f_fileno >= 0; return TRUE; } else { # anything else, including GLOBS without IO (even if they are blessed) # and non GLOB objects that look like filehandle objects cannot have a # valid file descriptor in fileno($fh) context so may break. return FALSE; } } sub set_io_path { my($fh, $path) = @_; bless $fh, 'Plack::Util::IOWithPath'; $fh->path($path); } sub content_length { my $body = shift; return unless defined $body; if (ref $body eq 'ARRAY') { my $cl = 0; for my $chunk (@$body) { $cl += length $chunk; } return $cl; } elsif ( is_real_fh($body) ) { return (-s $body) - tell($body); } return; } sub foreach { my($body, $cb) = @_; if (ref $body eq 'ARRAY') { for my $line (@$body) { $cb->($line) if length $line; } } else { local $/ = \65536 unless ref $/; while (defined(my $line = $body->getline)) { $cb->($line) if length $line; } $body->close; } } sub class_to_file { my $class = shift; $class =~ s!::!/!g; $class . ".pm"; } sub _load_sandbox { my $_file = shift; my $_package = $_file; $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg; local $0 = $_file; # so FindBin etc. works local @ARGV = (); # Some frameworks might try to parse @ARGV return eval sprintf <<'END_EVAL', $_package; package Plack::Sandbox::%s; { my $app = do $_file; if ( !$app && ( my $error = $@ || $! )) { die $error; } $app; } END_EVAL } sub load_psgi { my $stuff = shift; local $ENV{PLACK_ENV} = $ENV{PLACK_ENV} || 'development'; my $file = $stuff =~ /^[a-zA-Z0-9\_\:]+$/ ? class_to_file($stuff) : File::Spec->rel2abs($stuff); my $app = _load_sandbox($file); die "Error while loading $file: $@" if $@; return $app; } sub run_app($$) { my($app, $env) = @_; return eval { $app->($env) } || do { my $body = "Internal Server Error"; $env->{'psgi.errors'}->print($@); [ 500, [ 'Content-Type' => 'text/plain', 'Content-Length' => length($body) ], [ $body ] ]; }; } sub headers { my $headers = shift; inline_object( iter => sub { header_iter($headers, @_) }, get => sub { header_get($headers, @_) }, set => sub { header_set($headers, @_) }, push => sub { header_push($headers, @_) }, exists => sub { header_exists($headers, @_) }, remove => sub { header_remove($headers, @_) }, headers => sub { $headers }, ); } sub header_iter { my($headers, $code) = @_; my @headers = @$headers; # copy while (my($key, $val) = splice @headers, 0, 2) { $code->($key, $val); } } sub header_get { my($headers, $key) = (shift, lc shift); return () if not @$headers; my $i = 0; if (wantarray) { return map { $key eq lc $headers->[$i++] ? $headers->[$i++] : ++$i && (); } 1 .. @$headers/2; } while ($i < @$headers) { return $headers->[$i+1] if $key eq lc $headers->[$i]; $i += 2; } (); } sub header_set { my($headers, $key, $val) = @_; @$headers = ($key, $val), return if not @$headers; my ($i, $_key) = (0, lc $key); # locate and change existing header while ($i < @$headers) { $headers->[$i+1] = $val, last if $_key eq lc $headers->[$i]; $i += 2; } if ($i > $#$headers) { # didn't find it? push @$headers, $key, $val; return; } $i += 2; # found and changed it; so, first, skip that pair return if $i > $#$headers; # anything left? # yes... so do the same thing as header_remove # but for the tail of the array only, starting at $i my $keep; my @keep = grep { $_ & 1 ? $keep : ($keep = $_key ne lc $headers->[$_]); } $i .. $#$headers; my $remainder = @$headers - $i; return if @keep == $remainder; # if we're not changing anything... splice @$headers, $i, $remainder, ( _SPLICE_SAME_ARRAY_SEGFAULT ? @{[ @$headers[@keep] ]} # force different source array : @$headers[@keep] ); (); } sub header_push { my($headers, $key, $val) = @_; push @$headers, $key, $val; } sub header_exists { my($headers, $key) = (shift, lc shift); my $check; for (@$headers) { return 1 if ($check = not $check) and $key eq lc; } return !1; } sub header_remove { my($headers, $key) = (shift, lc shift); return if not @$headers; my $keep; my @keep = grep { $_ & 1 ? $keep : ($keep = $key ne lc $headers->[$_]); } 0 .. $#$headers; @$headers = @$headers[@keep] if @keep < @$headers; (); } sub status_with_no_entity_body { my $status = shift; return $status < 200 || $status == 204 || $status == 304; } sub encode_html { my $str = shift; $str =~ s/&/&/g; $str =~ s/>/>/g; $str =~ s/</</g; $str =~ s/"/"/g; $str =~ s/'/'/g; return $str; } sub inline_object { my %args = @_; bless \%args, 'Plack::Util::Prototype'; } sub response_cb { my($res, $cb) = @_; my $body_filter = sub { my($cb, $res) = @_; my $filter_cb = $cb->($res); # If response_cb returns a callback, treat it as a $body filter if (defined $filter_cb && ref $filter_cb eq 'CODE') { Plack::Util::header_remove($res->[1], 'Content-Length'); if (defined $res->[2]) { if (ref $res->[2] eq 'ARRAY') { for my $line (@{$res->[2]}) { $line = $filter_cb->($line); } # Send EOF. my $eof = $filter_cb->( undef ); push @{ $res->[2] }, $eof if defined $eof; } else { my $body = $res->[2]; my $getline = sub { $body->getline }; $res->[2] = Plack::Util::inline_object getline => sub { $filter_cb->($getline->()) }, close => sub { $body->close }; } } else { return $filter_cb; } } }; if (ref $res eq 'ARRAY') { $body_filter->($cb, $res); return $res; } elsif (ref $res eq 'CODE') { return sub { my $respond = shift; my $cb = $cb; # To avoid the nested closure leak for 5.8.x $res->(sub { my $res = shift; my $filter_cb = $body_filter->($cb, $res); if ($filter_cb) { my $writer = $respond->($res); if ($writer) { return Plack::Util::inline_object write => sub { $writer->write($filter_cb->(@_)) }, close => sub { my $chunk = $filter_cb->(undef); $writer->write($chunk) if defined $chunk; $writer->close; }; } } else { return $respond->($res); } }); }; } return $res; } package Plack::Util::Prototype; our $AUTOLOAD; sub can { return $_[0]->{$_[1]} if Scalar::Util::blessed($_[0]); goto &UNIVERSAL::can; } sub AUTOLOAD { my $self = shift; my $attr = $AUTOLOAD; $attr =~ s/.*://; if (ref($self->{$attr}) eq 'CODE') { $self->{$attr}->(@_); } else { Carp::croak(qq/Can't locate object method "$attr" via package "Plack::Util::Prototype"/); } } sub DESTROY { } package Plack::Util::IOWithPath; use parent qw(IO::Handle); sub path { my $self = shift; if (@_) { ${*$self}{+__PACKAGE__} = shift; } ${*$self}{+__PACKAGE__}; } package Plack::Util; 1; __END__ =head1 NAME Plack::Util - Utility subroutines for Plack server and framework developers =head1 FUNCTIONS =over 4 =item TRUE, FALSE my $true = Plack::Util::TRUE; my $false = Plack::Util::FALSE; Utility constants to include when you specify boolean variables in C<$env> hash (e.g. C<psgi.multithread>). =item load_class my $class = Plack::Util::load_class($class [, $prefix ]); Constructs a class name and C<require> the class. Throws an exception if the .pm file for the class is not found, just with the built-in C<require>. If C<$prefix> is set, the class name is prepended to the C<$class> unless C<$class> begins with C<+> sign, which means the class name is already fully qualified. my $class = Plack::Util::load_class("Foo"); # Foo my $class = Plack::Util::load_class("Baz", "Foo::Bar"); # Foo::Bar::Baz my $class = Plack::Util::load_class("+XYZ::ZZZ", "Foo::Bar"); # XYZ::ZZZ Note that this function doesn't validate (or "sanitize") the passed string, hence if you pass a user input to this function (which is an insecure thing to do in the first place) it might lead to unexpected behavior of loading files outside your C<@INC> path. If you want a generic module loading function, you should check out CPAN modules such as L<Module::Runtime>. =item is_real_fh if ( Plack::Util::is_real_fh($fh) ) { } returns true if a given C<$fh> is a real file handle that has a file descriptor. It returns false if C<$fh> is PerlIO handle that is not really related to the underlying file etc. =item content_length my $cl = Plack::Util::content_length($body); Returns the length of content from body if it can be calculated. If C<$body> is an array ref it's a sum of length of each chunk, if C<$body> is a real filehandle it's a remaining size of the filehandle, otherwise returns undef. =item set_io_path Plack::Util::set_io_path($fh, "/path/to/foobar.txt"); Sets the (absolute) file path to C<$fh> filehandle object, so you can call C<< $fh->path >> on it. As a side effect C<$fh> is blessed to an internal package but it can still be treated as a normal file handle. This module doesn't normalize or absolutize the given path, and is intended to be used from Server or Middleware implementations. See also L<IO::File::WithPath>. =item foreach Plack::Util::foreach($body, $cb); Iterate through I<$body> which is an array reference or IO::Handle-like object and pass each line (which is NOT really guaranteed to be a I<line>) to the callback function. It internally sets the buffer length C<$/> to 65536 in case it reads the binary file, unless otherwise set in the caller's code. =item load_psgi my $app = Plack::Util::load_psgi $psgi_file_or_class; Load C<app.psgi> file or a class name (like C<MyApp::PSGI>) and require the file to get PSGI application handler. If the file can't be loaded (e.g. file doesn't exist or has a perl syntax error), it will throw an exception. Since version 1.0006, this function would not load PSGI files from include paths (C<@INC>) unless it looks like a class name that only consists of C<[A-Za-z0-9_:]>. For example: Plack::Util::load_psgi("app.psgi"); # ./app.psgi Plack::Util::load_psgi("/path/to/app.psgi"); # /path/to/app.psgi Plack::Util::load_psgi("MyApp::PSGI"); # MyApp/PSGI.pm from @INC B<Security>: If you give this function a class name or module name that is loadable from your system, it will load the module. This could lead to a security hole: my $psgi = ...; # user-input: consider "Moose" $app = Plack::Util::load_psgi($psgi); # this would lead to 'require "Moose.pm"'! Generally speaking, passing an external input to this function is considered very insecure. If you really want to do that, validate that a given file name contains dots (like C<foo.psgi>) and also turn it into a full path in your caller's code. =item run_app my $res = Plack::Util::run_app $app, $env; Runs the I<$app> by wrapping errors with I<eval> and if an error is found, logs it to C<< $env->{'psgi.errors'} >> and returns the template 500 Error response. =item header_get, header_exists, header_set, header_push, header_remove my $hdrs = [ 'Content-Type' => 'text/plain' ]; my $v = Plack::Util::header_get($hdrs, $key); # First found only my @v = Plack::Util::header_get($hdrs, $key); my $bool = Plack::Util::header_exists($hdrs, $key); Plack::Util::header_set($hdrs, $key, $val); # overwrites existent header Plack::Util::header_push($hdrs, $key, $val); Plack::Util::header_remove($hdrs, $key); Utility functions to manipulate PSGI response headers array reference. The methods that read existent header value handles header name as case insensitive. my $hdrs = [ 'Content-Type' => 'text/plain' ]; my $v = Plack::Util::header_get($hdrs, 'content-type'); # 'text/plain' =item headers my $headers = [ 'Content-Type' => 'text/plain' ]; my $h = Plack::Util::headers($headers); $h->get($key); if ($h->exists($key)) { ... } $h->set($key => $val); $h->push($key => $val); $h->remove($key); $h->headers; # same reference as $headers Given a header array reference, returns a convenient object that has an instance methods to access C<header_*> functions with an OO interface. The object holds a reference to the original given C<$headers> argument and updates the reference accordingly when called write methods like C<set>, C<push> or C<remove>. It also has C<headers> method that would return the same reference. =item status_with_no_entity_body if (status_with_no_entity_body($res->[0])) { } Returns true if the given status code doesn't have any Entity body in HTTP response, i.e. it's 100, 101, 204 or 304. =item inline_object my $o = Plack::Util::inline_object( write => sub { $h->push_write(@_) }, close => sub { $h->push_shutdown }, ); $o->write(@stuff); $o->close; Creates an instant object that can react to methods passed in the constructor. Handy to create when you need to create an IO stream object for input or errors. =item encode_html my $encoded_string = Plack::Util::encode( $string ); Entity encodes C<<>, C<< > >>, C<&>, C<"> and C<'> in the input string and returns it. =item response_cb See L<Plack::Middleware/RESPONSE CALLBACK> for details. =back =cut �����������������������������������������������������Plack-1.0039/lib/Plack/Util/Accessor.pm�������������������������������������������������������������000644 �000765 �000024 �00000001654 12631015706 020426� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Util::Accessor; use strict; use warnings; sub import { shift; return unless @_; my $package = caller(); mk_accessors( $package, @_ ); } sub mk_accessors { my $package = shift; no strict 'refs'; foreach my $field ( @_ ) { *{ $package . '::' . $field } = sub { return $_[0]->{ $field } if scalar( @_ ) == 1; return $_[0]->{ $field } = scalar( @_ ) == 2 ? $_[1] : [ @_[1..$#_] ]; }; } } 1; __END__ =head1 NAME Plack::Util::Accessor - Accessor generation utility for Plack =head1 DESCRIPTION This module is just a simple accessor generator for Plack to replace the Class::Accessor::Fast usage and so our classes don't have to inherit from their accessor generator. =head1 SEE ALSO L<PSGI> L<http://plackperl.org/> =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut ������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Test/MockHTTP.pm�������������������������������������������������������������000644 �000765 �000024 �00000002032 12631015706 020246� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Test::MockHTTP; use strict; use warnings; use Carp; use HTTP::Request; use HTTP::Response; use HTTP::Message::PSGI; use Try::Tiny; sub new { my($class, $app) = @_; bless { app => $app }, $class; } sub request { my($self, $req) = @_; $req->uri->scheme('http') unless defined $req->uri->scheme; $req->uri->host('localhost') unless defined $req->uri->host; my $env = $req->to_psgi; my $res = try { HTTP::Response->from_psgi($self->{app}->($env)); } catch { HTTP::Response->from_psgi([ 500, [ 'Content-Type' => 'text/plain' ], [ $_ ] ]); }; $res->request($req); return $res; } 1; __END__ =head1 NAME Plack::Test::MockHTTP - Run mocked HTTP tests through PSGI applications =head1 DESCRIPTION Plack::Test::MockHTTP is a utility to run PSGI application given HTTP::Request objects and return HTTP::Response object out of PSGI application response. See L<Plack::Test> how to use this module. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::Test> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Test/Server.pm���������������������������������������������������������������000644 �000765 �000024 �00000002371 12631015706 020131� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Test::Server; use strict; use warnings; use Carp; use HTTP::Request; use HTTP::Response; use Test::TCP; use Plack::Loader; use Plack::LWPish; sub new { my($class, $app, %args) = @_; my $server = Test::TCP->new( code => sub { my $port = shift; my $server = Plack::Loader->auto(port => $port, host => ($args{host} || '127.0.0.1')); $server->run($app); exit; }, ); bless { server => $server, %args }, $class; } sub port { my $self = shift; $self->{server}->port; } sub request { my($self, $req) = @_; my $ua = $self->{ua} || Plack::LWPish->new( no_proxy => [qw/127.0.0.1/] ); $req->uri->scheme('http'); $req->uri->host($self->{host} || '127.0.0.1'); $req->uri->port($self->port); return $ua->request($req); } 1; __END__ =head1 NAME Plack::Test::Server - Run HTTP tests through live Plack servers =head1 DESCRIPTION Plack::Test::Server is a utility to run PSGI application with Plack server implementations, and run the live HTTP tests with the server using a callback. See L<Plack::Test> how to use this module. =head1 AUTHOR Tatsuhiko Miyagawa Tokuhiro Matsuno =head1 SEE ALSO L<Plack::Loader> L<Test::TCP> L<Plack::Test> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Test/Suite.pm����������������������������������������������������������������000644 �000765 �000024 �00000057732 12631015706 017767� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Test::Suite; use strict; use warnings; use Digest::MD5; use File::ShareDir; use HTTP::Request; use HTTP::Request::Common; use Test::More; use Test::TCP; use Plack::Loader; use Plack::Middleware::Lint; use Plack::Util; use Plack::Request; use Try::Tiny; use Plack::LWPish; my $share_dir = try { File::ShareDir::dist_dir('Plack') } || 'share'; $ENV{PLACK_TEST_SCRIPT_NAME} = ''; # 0: test name # 1: request generator coderef. # 2: request handler # 3: test case for response our @TEST = ( [ 'SCRIPT_NAME', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); is $res->content, "script_name=$ENV{PLACK_TEST_SCRIPT_NAME}"; }, sub { my $env = shift; return [ 200, ["Content-Type", "text/plain"], [ "script_name=$env->{SCRIPT_NAME}" ] ]; }, ], [ 'GET', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/?name=miyagawa"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, 'Hello, name=miyagawa'; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [ 'Hello, ' . $env->{QUERY_STRING} ], ]; }, ], [ 'POST', sub { my $cb = shift; my $res = $cb->(POST "http://127.0.0.1/", [name => 'tatsuhiko']); is $res->code, 200; is $res->message, 'OK'; is $res->header('Client-Content-Length'), 14; is $res->header('Client-Content-Type'), 'application/x-www-form-urlencoded'; is $res->header('content_type'), 'text/plain'; is $res->content, 'Hello, name=tatsuhiko'; }, sub { my $env = shift; my $body; $env->{'psgi.input'}->read($body, $env->{CONTENT_LENGTH}); return [ 200, [ 'Content-Type' => 'text/plain', 'Client-Content-Length' => $env->{CONTENT_LENGTH}, 'Client-Content-Type' => $env->{CONTENT_TYPE}, ], [ 'Hello, ' . $body ], ]; }, ], [ 'big POST', sub { my $cb = shift; my $chunk = "abcdefgh" x 12000; my $req = HTTP::Request->new(POST => "http://127.0.0.1/"); $req->content_length(length $chunk); $req->content_type('application/octet-stream'); $req->content($chunk); my $res = $cb->($req); is $res->code, 200; is $res->message, 'OK'; is $res->header('Client-Content-Length'), length $chunk; is length $res->content, length $chunk; is Digest::MD5::md5_hex($res->content), Digest::MD5::md5_hex($chunk); }, sub { my $env = shift; my $len = $env->{CONTENT_LENGTH}; my $body = ''; my $spin; while ($len > 0) { my $rc = $env->{'psgi.input'}->read($body, $env->{CONTENT_LENGTH}, length $body); $len -= $rc; last if $spin++ > 2000; } return [ 200, [ 'Content-Type' => 'text/plain', 'Client-Content-Length' => $env->{CONTENT_LENGTH}, 'Client-Content-Type' => $env->{CONTENT_TYPE}, ], [ $body ], ]; }, ], [ 'psgi.url_scheme', sub { my $cb = shift; my $res = $cb->(POST "http://127.0.0.1/"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, 'http'; }, sub { my $env = $_[0]; return [ 200, [ 'Content-Type' => 'text/plain', ], [ $env->{'psgi.url_scheme'} ], ]; }, ], [ 'return glob', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; like $res->content, qr/^package /; like $res->content, qr/END_MARK_FOR_TESTING$/; }, sub { my $env = shift; open my $fh, '<', __FILE__ or die $!; return [ 200, [ 'Content-Type' => 'text/plain', ], $fh, ]; }, ], [ 'filehandle', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo.jpg"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'image/jpeg'; is length $res->content, 2898; }, sub { my $env = shift; open my $fh, '<', "$share_dir/face.jpg"; return [ 200, [ 'Content-Type' => 'image/jpeg', 'Content-Length' => -s $fh ], $fh ]; }, ], [ 'bigger file', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/baybridge.jpg"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'image/jpeg'; is length $res->content, 14750; is Digest::MD5::md5_hex($res->content), '70546a79c7abb9c497ca91730a0686e4'; }, sub { my $env = shift; open my $fh, '<', "$share_dir/baybridge.jpg"; binmode $fh; return [ 200, [ 'Content-Type' => 'image/jpeg', 'Content-Length' => -s $fh ], $fh ]; }, ], [ 'handle HTTP-Header', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan", Foo => "Bar"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, 'Bar'; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [$env->{HTTP_FOO}], ]; }, ], [ 'handle HTTP-Cookie', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan", Cookie => "foo"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, 'foo'; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [$env->{HTTP_COOKIE}], ]; }, ], [ 'validate env', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, join("\n", 'REQUEST_METHOD:GET', "SCRIPT_NAME:$ENV{PLACK_TEST_SCRIPT_NAME}", 'PATH_INFO:/foo/', 'QUERY_STRING:dankogai=kogaidan', 'SERVER_NAME:127.0.0.1', "SERVER_PORT:" . $res->request->uri->port, )."\n"; }, sub { my $env = shift; my $body; $body .= $_ . ':' . $env->{$_} . "\n" for qw/REQUEST_METHOD SCRIPT_NAME PATH_INFO QUERY_STRING SERVER_NAME SERVER_PORT/; return [ 200, [ 'Content-Type' => 'text/plain', ], [$body], ]; }, ], [ '% encoding in PATH_INFO', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/bar%2cbaz"); is $res->content, "/foo/bar,baz", "PATH_INFO should be decoded per RFC 3875"; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [ $env->{PATH_INFO} ], ]; }, ], [ '% double encoding in PATH_INFO', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/bar%252cbaz"); is $res->content, "/foo/bar%2cbaz", "PATH_INFO should be decoded only once, per RFC 3875"; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [ $env->{PATH_INFO} ], ]; }, ], [ '% encoding in PATH_INFO (outside of URI characters)', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo%E3%81%82"); is $res->content, "/foo\x{e3}\x{81}\x{82}"; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [ $env->{PATH_INFO} ], ]; }, ], [ 'SERVER_PROTOCOL is required', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; like $res->content, qr{^HTTP/1\.[01]$}; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [$env->{SERVER_PROTOCOL}], ]; }, ], [ 'SCRIPT_NAME should not be undef', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan"); is $res->content, 1; }, sub { my $env = shift; my $cont = defined $env->{'SCRIPT_NAME'}; return [ 200, [ 'Content-Type' => 'text/plain', ], [$cont], ]; }, ], [ 'call close after read IO::Handle-like', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/call_close"); is($res->content, '1234'); }, sub { my $env = shift; { our $closed = -1; sub CalledClose::new { $closed = 0; my $i=0; bless \$i, 'CalledClose' } sub CalledClose::getline { my $self = shift; return $$self++ < 4 ? $$self : undef; } sub CalledClose::close { ::ok(1, 'closed') if defined &::ok } } return [ 200, [ 'Content-Type' => 'text/plain', ], CalledClose->new(), ]; }, ], [ 'has errors', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/has_errors"); is $res->content, 1; }, sub { my $env = shift; my $err = $env->{'psgi.errors'}; my $has_errors = defined $err; return [ 200, [ 'Content-Type' => 'text/plain', ], [$has_errors] ]; }, ], [ 'status line', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan"); is($res->status_line, '200 OK'); }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [1] ]; }, ], [ 'Do not crash when the app dies', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); is $res->code, 500; is $res->message, 'Internal Server Error'; }, sub { my $env = shift; open my $io, '>', \my $error; $env->{'psgi.errors'} = $io; die "Throwing an exception from app handler. Server shouldn't crash."; }, ], [ 'multi headers (request)', sub { my $cb = shift; my $req = HTTP::Request->new( GET => "http://127.0.0.1/", ); $req->push_header(Foo => "bar"); $req->push_header(Foo => "baz"); my $res = $cb->($req); like($res->content, qr/^bar,\s*baz$/); }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [ $env->{HTTP_FOO} ] ]; }, ], [ 'multi headers (response)', sub { my $cb = shift; my $res = $cb->(HTTP::Request->new(GET => "http://127.0.0.1/")); my $foo = $res->header('X-Foo'); like $foo, qr/foo,\s*bar,\s*baz/; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', 'X-Foo', 'foo', 'X-Foo', 'bar, baz' ], [ 'hi' ] ]; }, ], [ 'Do not set $env->{COOKIE}', sub { my $cb = shift; my $req = HTTP::Request->new( GET => "http://127.0.0.1/", ); $req->push_header(Cookie => "foo=bar"); my $res = $cb->($req); is($res->header('X-Cookie'), 0); is $res->content, 'foo=bar'; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', 'X-Cookie' => $env->{COOKIE} ? 1 : 0 ], [ $env->{HTTP_COOKIE} ] ]; }, ], [ 'no entity headers on 304', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); is $res->code, 304; is $res->message, 'Not Modified'; is $res->content, ''; ok ! defined $res->header('content_type'), "No Content-Type"; ok ! defined $res->header('content_length'), "No Content-Length"; ok ! defined $res->header('transfer_encoding'), "No Transfer-Encoding"; }, sub { my $env = shift; return [ 304, [], [] ]; }, ], [ 'REQUEST_URI is set', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo/bar%20baz%73?x=a"); is $res->content, $ENV{PLACK_TEST_SCRIPT_NAME} . "/foo/bar%20baz%73?x=a"; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], [ $env->{REQUEST_URI} ] ]; }, ], [ 'filehandle with path()', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/foo.jpg"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'image/jpeg'; is length $res->content, 2898; }, sub { my $env = shift; open my $fh, '<', "$share_dir/face.jpg"; Plack::Util::set_io_path($fh, "$share_dir/face.jpg"); return [ 200, [ 'Content-Type' => 'image/jpeg', 'Content-Length' => -s $fh ], $fh ]; }, ], [ 'a big header value > 128 bytes', sub { my $cb = shift; my $req = GET "http://127.0.0.1/"; my $v = ("abcdefgh" x 16); $req->header('X-Foo' => $v); my $res = $cb->($req); is $res->code, 200; is $res->message, 'OK'; is $res->content, $v; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], [ $env->{HTTP_X_FOO} ], ]; }, ], [ 'coderef res', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/?name=miyagawa"); return if $res->code == 501; is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, 'Hello, name=miyagawa'; }, sub { my $env = shift; $env->{'psgi.streaming'} or return [ 501, ['Content-Type','text/plain'], [] ]; return sub { my $respond = shift; $respond->([ 200, [ 'Content-Type' => 'text/plain', ], [ 'Hello, ' . $env->{QUERY_STRING} ], ]); } }, ], [ 'coderef streaming', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/?name=miyagawa"); return if $res->code == 501; is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, 'Hello, name=miyagawa'; }, sub { my $env = shift; $env->{'psgi.streaming'} or return [ 501, ['Content-Type','text/plain'], [] ]; return sub { my $respond = shift; my $writer = $respond->([ 200, [ 'Content-Type' => 'text/plain', ], ]); $writer->write("Hello, "); $writer->write($env->{QUERY_STRING}); $writer->close(); } }, ], [ 'CRLF output and FCGI parse bug', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); is $res->header("Foo"), undef; is $res->content, "Foo: Bar\r\n\r\nHello World"; }, sub { return [ 200, [ "Content-Type", "text/plain" ], [ "Foo: Bar\r\n\r\nHello World" ] ]; }, ], [ 'newlines', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); is length($res->content), 7; }, sub { return [ 200, [ "Content-Type", "text/plain" ], [ "Bar\nBaz" ] ]; }, ], [ 'test 404', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); is $res->code, 404; is $res->message, 'Not Found'; is $res->content, 'Not Found'; }, sub { return [ 404, [ "Content-Type", "text/plain" ], [ "Not Found" ] ]; }, ], [ 'request->input seekable', sub { my $cb = shift; my $req = HTTP::Request->new(POST => "http://127.0.0.1/"); $req->content("body"); $req->content_type('text/plain'); $req->content_length(4); my $res = $cb->($req); is $res->content, 'body'; }, sub { my $req = Plack::Request->new(shift); return [ 200, [ "Content-Type", "text/plain" ], [ $req->content ] ]; }, ], [ 'request->content on GET', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1/"); ok $res->is_success; }, sub { my $req = Plack::Request->new(shift); $req->content; return [ 200, [ "Content-Type", "text/plain" ], [ "OK" ] ]; }, ], [ 'handle Authorization header', sub { my $cb = shift; SKIP: { skip "Authorization header is unsupported under CGI", 4 if ($ENV{PLACK_TEST_HANDLER} || "") eq "CGI"; { my $req = HTTP::Request->new( GET => "http://127.0.0.1/", ); $req->push_header(Authorization => 'Basic XXXX'); my $res = $cb->($req); is $res->header('X-AUTHORIZATION'), 1; is $res->content, 'Basic XXXX'; }; { my $req = HTTP::Request->new( GET => "http://127.0.0.1/", ); my $res = $cb->($req); is $res->header('X-AUTHORIZATION'), 0; is $res->content, 'no_auth'; }; }; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', 'X-AUTHORIZATION' => exists($env->{HTTP_AUTHORIZATION}) ? 1 : 0 ], [ $env->{HTTP_AUTHORIZATION} || 'no_auth' ], ]; }, ], [ 'repeated slashes', sub { my $cb = shift; my $res = $cb->(GET "http://127.0.0.1//foo///bar/baz"); is $res->code, 200; is $res->message, 'OK'; is $res->header('content_type'), 'text/plain'; is $res->content, '//foo///bar/baz'; }, sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain', ], [ $env->{PATH_INFO} ], ]; }, ], ); sub runtests { my($class, $runner) = @_; for my $test (@TEST) { $runner->(@$test); } } sub run_server_tests { my($class, $server, $server_port, $http_port, %args) = @_; if (ref $server ne 'CODE') { my $server_class = $server; $server = sub { my($port, $app) = @_; my $server = Plack::Loader->load($server_class, port => $port, host => "127.0.0.1", %args); $app = Plack::Middleware::Lint->wrap($app); $server->run($app); } } test_tcp( client => sub { my $port = shift; my $ua = Plack::LWPish->new( no_proxy => [qw/127.0.0.1/] ); for my $i (0..$#TEST) { my $test = $TEST[$i]; note $test->[0]; my $cb = sub { my $req = shift; $req->uri->port($http_port || $port); $req->uri->path(($ENV{PLACK_TEST_SCRIPT_NAME}||"") . $req->uri->path); $req->header('X-Plack-Test' => $i); return $ua->request($req); }; $test->[1]->($cb); } }, server => sub { my $port = shift; my $app = $class->test_app_handler; $server->($port, $app); exit(0); # for Test::TCP }, port => $server_port, ); } sub test_app_handler { return sub { my $env = shift; $TEST[$env->{HTTP_X_PLACK_TEST}][2]->($env); }; } 1; __END__ =head1 NAME Plack::Test::Suite - Test suite for Plack handlers =head1 SYNOPSIS use Test::More; use Plack::Test::Suite; Plack::Test::Suite->run_server_tests('Your::Handler'); done_testing; =head1 DESCRIPTION Plack::Test::Suite is a test suite to test a new PSGI server implementation. It automatically loads a new handler environment and uses LWP to send HTTP requests to the local server to make sure your handler implements the PSGI specification correctly. Note that the handler name doesn't include the C<Plack::Handler::> prefix, i.e. if you have a new Plack handler Plack::Handler::Foo, your test script would look like: Plack::Test::Suite->run_server_tests('Foo'); Developers writing Plack applications should look at C<Plack::Test> for testing, as subclassing C<Plack::Handler> is for developing server implementations. =head1 AUTHOR Tokuhiro Matsuno Tatsuhiko Miyagawa Kazuho Oku =cut END_MARK_FOR_TESTING ��������������������������������������Plack-1.0039/lib/Plack/Request/Upload.pm������������������������������������������������������������000644 �000765 �000024 �00000003160 12631015706 020615� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Request::Upload; use strict; use warnings; use Carp (); sub new { my($class, %args) = @_; bless { headers => $args{headers}, tempname => $args{tempname}, size => $args{size}, filename => $args{filename}, }, $class; } sub filename { $_[0]->{filename} } sub headers { $_[0]->{headers} } sub size { $_[0]->{size} } sub tempname { $_[0]->{tempname} } sub path { $_[0]->{tempname} } sub content_type { my $self = shift; $self->{headers}->content_type(@_); } sub type { shift->content_type(@_) } sub basename { my $self = shift; unless (defined $self->{basename}) { require File::Spec::Unix; my $basename = $self->{filename}; $basename =~ s|\\|/|g; $basename = ( File::Spec::Unix->splitpath($basename) )[2]; $basename =~ s|[^\w\.-]+|_|g; $self->{basename} = $basename; } $self->{basename}; } 1; __END__ =head1 NAME Plack::Request::Upload - handles file upload requests =head1 SYNOPSIS # $req is Plack::Request my $upload = $req->uploads->{field}; $upload->size; $upload->path; $upload->content_type; $upload->basename; =head1 METHODS =over 4 =item size Returns the size of Uploaded file. =item path Returns the path to the temporary file where uploaded file is saved. =item content_type Returns the content type of the uploaded file. =item filename Returns the original filename in the client. =item basename Returns basename for "filename". =back =head1 AUTHORS Kazuhiro Osawa Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::Request>, L<Catalyst::Request::Upload> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/AccessLog/��������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 021323� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/AccessLog.pm������������������������������������������������������000644 �000765 �000024 �00000014020 12631015706 021656� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::AccessLog; use strict; use warnings; use parent qw( Plack::Middleware ); use Plack::Util::Accessor qw( logger format compiled_format char_handlers block_handlers ); use Apache::LogFormat::Compiler; my %formats = ( common => '%h %l %u %t "%r" %>s %b', combined => '%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-agent}i"', ); sub prepare_app { my $self = shift; my $fmt = $self->format || "combined"; $fmt = $formats{$fmt} if exists $formats{$fmt}; $self->compiled_format(Apache::LogFormat::Compiler->new($fmt, char_handlers => $self->char_handlers || {}, block_handlers => $self->block_handlers || {}, )); } sub call { my $self = shift; my($env) = @_; my $res = $self->app->($env); if ( ref($res) && ref($res) eq 'ARRAY' ) { my $content_length = Plack::Util::content_length($res->[2]); my $log_line = $self->log_line($res->[0], $res->[1], $env, { content_length => $content_length }); if ( my $logger = $self->logger ) { $logger->($log_line); } else { $env->{'psgi.errors'}->print($log_line); } return $res; } return $self->response_cb($res, sub { my $res = shift; my $content_length = Plack::Util::content_length($res->[2]); my $log_line = $self->log_line($res->[0], $res->[1], $env, { content_length => $content_length }); if ( my $logger = $self->logger ) { $logger->($log_line); } else { $env->{'psgi.errors'}->print($log_line); } }); } sub log_line { my($self, $status, $headers, $env, $opts) = @_; $self->compiled_format->log_line( $env, [$status,$headers], $opts->{content_length}, $opts->{time} ); } 1; __END__ =for stopwords LogFormat =head1 NAME Plack::Middleware::AccessLog - Logs requests like Apache's log format =head1 SYNOPSIS # in app.psgi use Plack::Builder; builder { enable "Plack::Middleware::AccessLog", format => "combined"; $app; }; =head1 DESCRIPTION Plack::Middleware::AccessLog forwards the request to the given app and logs request and response details to the logger callback. The format can be specified using Apache-like format strings (or C<combined> or C<common> for the default formats). If none is specified C<combined> is used. This middleware uses calculable Content-Length by checking body type, and cannot log the time taken to serve requests. It also logs the request B<before> the response is actually sent to the client. Use L<Plack::Middleware::AccessLog::Timed> if you want to log details B<after> the response is transmitted (more like a real web server) to the client. This middleware is enabled by default when you run L<plackup> as a default C<development> environment. =head1 CONFIGURATION =over 4 =item format enable "Plack::Middleware::AccessLog", format => '%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-agent}i"'; Takes a format string (or a preset template C<combined> or C<custom>) to specify the log format. This middleware uses L<Apache::LogFormat::Compiler> to generate access_log lines. See more details on perldoc L<Apache::LogFormat::Compiler> %% a percent sign %h REMOTE_ADDR from the PSGI environment, or - %l remote logname not implemented (currently always -) %u REMOTE_USER from the PSGI environment, or - %t [local timestamp, in default format] %r REQUEST_METHOD, REQUEST_URI and SERVER_PROTOCOL from the PSGI environment %s the HTTP status code of the response %b content length of the response %T custom field for handling times in subclasses %D custom field for handling sub-second times in subclasses %v SERVER_NAME from the PSGI environment, or - %V HTTP_HOST or SERVER_NAME from the PSGI environment, or - %p SERVER_PORT from the PSGI environment %P the worker's process id %m REQUEST_METHOD from the PSGI environment %U PATH_INFO from the PSGI environment %q QUERY_STRING from the PSGI environment %H SERVER_PROTOCOL from the PSGI environment Some of these format fields are only supported by middleware that subclasses C<AccessLog>. In addition, custom values can be referenced, using C<%{name}>, with one of the mandatory modifier flags C<i>, C<o> or C<t>: %{variable-name}i HTTP_VARIABLE_NAME value from the PSGI environment %{header-name}o header-name header in the response %{time-format]t localtime in the specified strftime format =item logger my $logger = Log::Dispatch->new(...); enable "Plack::Middleware::AccessLog", logger => sub { $logger->log(level => 'debug', message => @_) }; Sets a callback to print log message to. It prints to the C<psgi.errors> output stream by default. =item char_handlers my $handlers = { 'z' => sub { my ($env,$req) = @_; return $env->{HTTP_X_FORWARDED_FOR}; } }; enable "Plack::Middleware::AccessLog", format => '%z %{HTTP_X_FORWARDED_FOR|REMOTE_ADDR}Z', char_handlers => $handlers; Takes a hash reference and passes it to the underlying L<Apache::LogFormat::Compiler>'s C<char_handlers>. For more details see L<Apache::LogFormat::Compiler/ADD CUSTOM FORMAT STRING>. =item block_handlers my $handlers = { 'Z' => sub { my ($block,$env,$req) = @_; # block eq 'HTTP_X_FORWARDED_FOR|REMOTE_ADDR' my ($main, $alt) = split('\|', $args); return exists $env->{$main} ? $env->{$main} : $env->{$alt}; } }; enable "Plack::Middleware::AccessLog", format => '%z %{HTTP_X_FORWARDED_FOR|REMOTE_ADDR}Z', block_handlers => $handlers; Takes a hash reference and passes it to the underlying L<Apache::LogFormat::Compiler>'s C<block_handlers>. For more details see L<Apache::LogFormat::Compiler/ADD CUSTOM FORMAT STRING>. =back =head1 AUTHORS Tatsuhiko Miyagawa Masahiro Nagano =head1 SEE ALSO L<Apache::LogFormat::Compiler>, L<http://httpd.apache.org/docs/2.2/mod/mod_log_config.html> Rack::CustomLogger =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Auth/�������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 020361� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/BufferedStreaming.pm����������������������������������������������000644 �000765 �000024 �00000003340 12631015706 023412� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::BufferedStreaming; use strict; no warnings; use Carp; use Plack::Util; use Plack::Util::Accessor qw(force); use Scalar::Util qw(weaken); use parent qw(Plack::Middleware); sub call { my ( $self, $env ) = @_; my $caller_supports_streaming = $env->{'psgi.streaming'}; $env->{'psgi.streaming'} = Plack::Util::TRUE; my $res = $self->app->($env); return $res if $caller_supports_streaming && !$self->force; if ( ref($res) eq 'CODE' ) { my $ret; $res->(sub { my $write = shift; if ( @$write == 2 ) { my @body; $ret = [ @$write, \@body ]; return Plack::Util::inline_object( write => sub { push @body, $_[0] }, close => sub { }, ); } else { $ret = $write; return; } }); return $ret; } else { return $res; } } 1; __END__ =head1 NAME Plack::Middleware::BufferedStreaming - Enable buffering for non-streaming aware servers =head1 SYNOPSIS enable "BufferedStreaming"; =head1 DESCRIPTION Plack::Middleware::BufferedStreaming is a PSGI middleware component that wraps the application that uses C<psgi.streaming> interface to run on the servers that do not support the interface, by buffering the writer output to a temporary buffer. This middleware doesn't do anything and bypass the application if the server supports C<psgi.streaming> interface, unless you set C<force> option (see below). =head1 OPTIONS =over 4 =item force Force enable this middleware only if the container supports C<psgi.streaming>. =back =head1 AUTHOR Yuval Kogman Tatsuhiko Miyagawa =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Chunked.pm��������������������������������������������������������000644 �000765 �000024 �00000002704 12631015706 021402� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Chunked; use strict; use parent qw(Plack::Middleware); use Plack::Util; sub call { my($self, $env) = @_; my $res = $self->app->($env); $self->response_cb($res, sub { my $res = shift; my $h = Plack::Util::headers($res->[1]); if ($env->{'SERVER_PROTOCOL'} ne 'HTTP/1.0' and ! Plack::Util::status_with_no_entity_body($res->[0]) and ! $h->exists('Content-Length') and ! $h->exists('Transfer-Encoding') ) { $h->set('Transfer-Encoding' => 'chunked'); my $done; return sub { my $chunk = shift; return if $done; unless (defined $chunk) { $done = 1; return "0\015\012\015\012"; } return '' unless length $chunk; return sprintf('%x', length $chunk) . "\015\012$chunk\015\012"; }; } }); } 1; __END__ =head1 NAME Plack::Middleware::Chunked - Applies chunked encoding to the response body =head1 SYNOPSIS # Mostly from server implemenations $app = Plack::Middeware::Chunked->wrap($app); =head1 DESCRIPTION Plack::Middeware::Chunked is a middleware, or rather a library for PSGI server to automatically add chunked encoding to the response body when Content-Length is not set in the response header. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO Rack::Chunked =cut ������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Conditional.pm����������������������������������������������������000644 �000765 �000024 �00000004146 12631015706 022266� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Conditional; use strict; use parent qw(Plack::Middleware); use Plack::Util::Accessor qw( condition middleware builder ); sub prepare_app { my $self = shift; $self->middleware( $self->builder->($self->app) ); } sub call { my($self, $env) = @_; my $app = $self->condition->($env) ? $self->middleware : $self->app; return $app->($env); } 1; __END__ =head1 NAME Plack::Middleware::Conditional - Conditional wrapper for Plack middleware =head1 SYNOPSIS use Plack::Builder; builder { enable_if { $_[0]->{REMOTE_ADDR} eq '127.0.0.1' } 'StackTrace', force => 1; $app; }; # or using the OO interface: $app = Plack::Middleware::Conditional->wrap( $app, condition => sub { $_[0]->{REMOTE_ADDR} eq '127.0.0.1' }, builder => sub { Plack::Middleware::StackTrace->wrap($_[0], force => 1) }, ); =head1 DESCRIPTION Plack::Middleware::Conditional is a piece of meta-middleware, to run a specific middleware component under runtime conditions. The goal of this middleware is to avoid baking runtime configuration options in individual middleware components, and rather share them as another middleware component. =head1 EXAMPLES Note that some of the middleware component names are just made up for the explanation and might not exist. # Minify JavaScript if the browser is Firefox enable_if { $_[0]->{HTTP_USER_AGENT} =~ /Firefox/ } 'JavaScriptMinifier'; # Enable Stacktrace when being accessed from the local network enable_if { $_[0]->{REMOTE_ADDR} =~ /^10\.0\.1\.*/ } 'StackTrace'; # Work with other conditional setter middleware: # Transcode Jpeg on the fly for mobile clients builder { enable 'MobileDetector'; enable_if { $_[0]->{'plack.mobile_detected'} } 'TranscodeJpeg', max_size => 30_000; $app; }; Note that in the last example I<MobileDetector> should come first because the conditional check runs in I<pre-run> conditions, which is from outer to inner: that is, from the top to the bottom in the Builder DSL code. =head1 AUTHOR Tatsuhiko Miyagawa Steve Cook =head1 SEE ALSO L<Plack::Builder> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/ConditionalGET.pm�������������������������������������������������000644 �000765 �000024 �00000004104 12631015706 022620� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::ConditionalGET; use strict; use parent qw( Plack::Middleware ); use Plack::Util; sub call { my $self = shift; my $env = shift; my $res = $self->app->($env); return $res unless $env->{REQUEST_METHOD} =~ /^(GET|HEAD)$/; $self->response_cb($res, sub { my $res = shift; my $h = Plack::Util::headers($res->[1]); if ( $self->etag_matches($h, $env) || $self->not_modified_since($h, $env) ) { $res->[0] = 304; $h->remove($_) for qw( Content-Type Content-Length Content-Disposition ); if ($res->[2]) { $res->[2] = []; } else { return sub { return defined $_[0] ? '' : undef; }; } } }); } no warnings 'uninitialized'; # RFC 2616 14.25 says it's OK and expected to use 'eq' :) # > Note: When handling an If-Modified-Since header field, some # > servers will use an exact date comparison function, rather than a # > less-than function, for deciding whether to send a 304 ... sub etag_matches { my($self, $h, $env) = @_; $h->exists('ETag') && $h->get('ETag') eq _value($env->{HTTP_IF_NONE_MATCH}); } sub not_modified_since { my($self, $h, $env) = @_; $h->exists('Last-Modified') && $h->get('Last-Modified') eq _value($env->{HTTP_IF_MODIFIED_SINCE}); } sub _value { my $str = shift; # IE sends wrong formatted value(i.e. "Thu, 03 Dec 2009 01:46:32 GMT; length=17936") $str =~ s/;.*$//; return $str; } 1; __END__ =head1 NAME Plack::Middleware::ConditionalGET - Middleware to enable conditional GET =head1 SYNOPSIS builder { enable "ConditionalGET"; .... }; =head1 DESCRIPTION This middleware enables conditional GET and HEAD using C<If-None-Match> and C<If-Modified-Since> header. The application should set either or both of C<Last-Modified> or C<ETag> response headers per RFC 2616. When either of the conditions is met, the response body is set to be zero length and the status is set to 304 Not Modified. =head1 SEE ALSO Rack::ConditionalGet =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/ContentLength.pm��������������������������������������������������000644 �000765 �000024 �00000002571 12631015706 022577� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::ContentLength; use strict; use warnings; use parent qw( Plack::Middleware ); use Plack::Util; sub call { my $self = shift; my $res = $self->app->(@_); return $self->response_cb($res, sub { my $res = shift; my $h = Plack::Util::headers($res->[1]); if (!Plack::Util::status_with_no_entity_body($res->[0]) && !$h->exists('Content-Length') && !$h->exists('Transfer-Encoding') && defined(my $content_length = Plack::Util::content_length($res->[2]))) { $h->push('Content-Length' => $content_length); } }); } 1; __END__ =head1 NAME Plack::Middleware::ContentLength - Adds Content-Length header automatically =head1 SYNOPSIS # in app.psgi builder { enable "Plack::Middleware::ContentLength"; $app; } # Or in Plack::Handler::* $app = Plack::Middleware::ContentLength->wrap($app); =head1 DESCRIPTION Plack::Middleware::ContentLength is a middleware that automatically adds C<Content-Length> header when it's appropriate i.e. the response has a content body with calculable size (array of chunks or a real filehandle). This middleware can also be used as a library from PSGI server implementations to automatically set C<Content-Length> rather than in the end user level. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO Rack::ContentLength =cut ���������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/ContentMD5.pm�����������������������������������������������������000644 �000765 �000024 �00000002204 12631015706 021734� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::ContentMD5; use strict; use warnings; use parent qw( Plack::Middleware ); use Plack::Util; use Digest::MD5 qw/md5_hex/; sub call { my $self = shift; my $res = $self->app->(@_); $self->response_cb($res, sub { my $res = shift; return unless defined $res->[2]; return if (Plack::Util::status_with_no_entity_body($res->[0])); my $h = Plack::Util::headers($res->[1]); return if ( $h->exists('Content-MD5') ); my $body = $res->[2]; if (ref $body eq 'ARRAY') { $h->set('Content-MD5', md5_hex(@$body)); } # Do we need support $fh? return; }); } 1; __END__ =head1 NAME Plack::Middleware::ContentMD5 - Automatically sets the Content-MD5 header on all String bodies =head1 SYNOPSIS use Plack::Builder; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; }; builder { enable "Plack::Middleware::ContentMD5"; $app; }; =head1 DESCRIPTION Automatically sets the Content-MD5 header on all String bodies =head1 AUTHOR Fayland Lam =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/ErrorDocument.pm��������������������������������������������������000644 �000765 �000024 �00000007425 12631015706 022616� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::ErrorDocument; use strict; use warnings; use parent qw(Plack::Middleware); use Plack::MIME; use Plack::Util; use Plack::Util::Accessor qw( subrequest ); use HTTP::Status qw(is_error); sub call { my $self = shift; my $env = shift; my $r = $self->app->($env); $self->response_cb($r, sub { my $r = shift; unless (is_error($r->[0]) && exists $self->{$r->[0]}) { return; } my $path = $self->{$r->[0]}; if ($self->subrequest) { for my $key (keys %$env) { unless ($key =~ /^psgi/) { $env->{'psgix.errordocument.' . $key} = $env->{$key}; } } # TODO: What if SCRIPT_NAME is not empty? $env->{REQUEST_METHOD} = 'GET'; $env->{REQUEST_URI} = $path; $env->{PATH_INFO} = $path; $env->{QUERY_STRING} = ''; delete $env->{CONTENT_LENGTH}; my $sub_r = $self->app->($env); if ($sub_r->[0] == 200) { $r->[1] = $sub_r->[1]; if (@$r == 3) { $r->[2] = $sub_r->[2]; } else { my $full_sub_response = ''; Plack::Util::foreach($sub_r->[2], sub { $full_sub_response .= $_[0]; }); my $returned; return sub { if ($returned) { return defined($_[0]) ? '' : undef; } $returned = 1; return $full_sub_response; } } } # TODO: allow 302 here? } else { my $h = Plack::Util::headers($r->[1]); $h->remove('Content-Length'); $h->remove('Content-Encoding'); $h->remove('Transfer-Encoding'); $h->set('Content-Type', Plack::MIME->mime_type($path)); open my $fh, "<", $path or die "$path: $!"; if ($r->[2]) { $r->[2] = $fh; } else { my $done; return sub { unless ($done) { $done = 1; return join '', <$fh>; } return defined $_[0] ? '' : undef; }; }; } }); } 1; __END__ =head1 NAME Plack::Middleware::ErrorDocument - Set Error Document based on HTTP status code =head1 SYNOPSIS # in app.psgi use Plack::Builder; builder { enable "Plack::Middleware::ErrorDocument", 500 => '/uri/errors/500.html', 404 => '/uri/errors/404.html', subrequest => 1; $app; }; =head1 DESCRIPTION Plack::Middleware::ErrorDocument allows you to customize error screen by setting paths (file system path or URI path) of error pages per status code. =head1 CONFIGURATIONS =over 4 =item subrequest A boolean flag to serve error pages using a new GET sub request. Defaults to false, which means it serves error pages using file system path. builder { enable "Plack::Middleware::ErrorDocument", 502 => '/home/www/htdocs/errors/maint.html'; enable "Plack::Middleware::ErrorDocument", 404 => '/static/404.html', 403 => '/static/403.html', subrequest => 1; $app; }; This configuration serves 502 error pages from file system directly assuming that's when you probably maintain database etc. but serves 404 and 403 pages using a sub request so your application can do some logic there like logging or doing suggestions. When using a subrequest, the subrequest should return a regular '200' response. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Head.pm�����������������������������������������������������������000644 �000765 �000024 �00000001351 12631015706 020657� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Head; use strict; use warnings; use parent qw(Plack::Middleware); sub call { my($self, $env) = @_; return $self->app->($env) unless $env->{REQUEST_METHOD} eq 'HEAD'; $self->response_cb($self->app->($env), sub { my $res = shift; if ($res->[2]) { $res->[2] = []; } else { return sub { return defined $_[0] ? '': undef; }; } }); } 1; __END__ =head1 NAME Plack::Middleware::Head - auto delete response body in HEAD requests =head1 SYNOPSIS enable "Head"; =head1 DESCRIPTION This middleware deletes response body in HEAD requests. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO Rack::Head =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/HTTPExceptions.pm�������������������������������������������������000644 �000765 �000024 �00000007642 12631015706 022650� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::HTTPExceptions; use strict; use parent qw(Plack::Middleware); use Plack::Util::Accessor qw(rethrow); use Carp (); use Try::Tiny; use Scalar::Util 'blessed'; use HTTP::Status (); sub prepare_app { my $self = shift; $self->rethrow(1) if ($ENV{PLACK_ENV} || '') eq 'development'; } sub call { my($self, $env) = @_; my $res = try { $self->app->($env); } catch { $self->transform_error($_, $env); }; return $res if ref $res eq 'ARRAY'; return sub { my $respond = shift; my $writer; try { $res->(sub { return $writer = $respond->(@_) }); } catch { if ($writer) { Carp::cluck $_; $writer->close; } else { my $res = $self->transform_error($_, $env); $respond->($res); } }; }; } sub transform_error { my($self, $e, $env) = @_; my($code, $message); if (blessed $e && $e->can('as_psgi')) { return $e->as_psgi; } if (blessed $e && $e->can('code')) { $code = $e->code; $message = $e->can('as_string') ? $e->as_string : overload::Method($e, '""') ? "$e" : undef; } else { if ($self->rethrow) { die $e; } else { $code = 500; $env->{'psgi.errors'}->print($e); } } if ($code !~ /^[3-5]\d\d$/) { die $e; # rethrow } $message ||= HTTP::Status::status_message($code); my @headers = ( 'Content-Type' => 'text/plain', 'Content-Length' => length($message), ); if ($code =~ /^3/ && (my $loc = eval { $e->location })) { push(@headers, Location => $loc); } return [ $code, \@headers, [ $message ] ]; } 1; __END__ =head1 NAME Plack::Middleware::HTTPExceptions - Catch HTTP exceptions =head1 SYNOPSIS use HTTP::Exception; my $app = sub { # ... HTTP::Exception::500->throw; }; builder { enable "HTTPExceptions", rethrow => 1; $app; }; =head1 DESCRIPTION Plack::Middleware::HTTPExceptions is a PSGI middleware component to catch exceptions from applications that can be translated into HTTP status codes. Your application is supposed to throw an object that implements a C<code> method which returns the HTTP status code, such as 501 or 404. This middleware catches them and creates a valid response out of the code. If the C<code> method returns a code that is not an HTTP redirect or error code (3xx, 4xx, or 5xx), the exception will be rethrown. The exception object may also implement C<as_string> or overload stringification to represent the text of the error. The text defaults to the status message of the error code, such as I<Service Unavailable> for C<503>. Finally, the exception object may implement C<as_psgi>, and the result of this will be returned directly as the PSGI response. If the code is in the 3xx range and the exception implements the 'location' method (HTTP::Exception::3xx does), the Location header will be set in the response, so you can do redirects this way. There are CPAN modules L<HTTP::Exception> and L<HTTP::Throwable>, and they are perfect to throw from your application to let this middleware catch and display, but you can also implement your own exception class to throw. If the thrown exception is not an object that implements either a C<code> or an C<as_psgi> method, a 500 error will be returned, and the exception is printed to the psgi.errors stream. Alternatively, you can pass a true value for the C<rethrow> parameter for this middleware, and the exception will instead be rethrown. This is enabled by default when C<PLACK_ENV> is set to C<development>, so that the L<StackTrace|Plack::Middleware::StackTrace> middleware can catch it instead. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO paste.httpexceptions L<HTTP::Exception> L<HTTP::Throwable> =cut ����������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/IIS6ScriptNameFix.pm����������������������������������������������000644 �000765 �000024 �00000002271 12631015706 023167� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::IIS6ScriptNameFix; use strict; use parent 'Plack::Middleware'; sub call { my($self, $env) = @_; if ($env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ /IIS\/[6-9]\.[0-9]/) { my @script_name = split(m!/!, $env->{PATH_INFO}); my @path_translated = split(m!/|\\\\?!, $env->{PATH_TRANSLATED}); my @path_info; while ($script_name[$#script_name] eq $path_translated[$#path_translated]) { pop(@path_translated); unshift(@path_info, pop(@script_name)); } unshift(@path_info, '', ''); $env->{PATH_INFO} = join('/', @path_info); $env->{SCRIPT_NAME} = join('/', @script_name); } return $self->app->($env); } 1; __END__ =head1 NAME Plack::Middleware::IIS6ScriptNameFix - fixes wrong SCRIPT_NAME and PATH_INFO that IIS6 sets =head1 SYNOPSIS # in your app.psgi use Plack::Builder; builder { enable "IIS6ScriptNameFix"; $app; }; # Or from the command line plackup -s FCGI -e 'enable "IIS6ScriptNameFix"' /path/to/app.psgi =head1 DESCRIPTION This middleware fixes wrong C<SCRIPT_NAME> and C<PATH_INFO> set by IIS6. =head1 AUTHORS Florian Ragwitz =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/IIS7KeepAliveFix.pm�����������������������������������������������000644 �000765 �000024 �00000002203 12631015706 022763� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::IIS7KeepAliveFix; use strict; use parent 'Plack::Middleware'; use Plack::Util; sub call { my($self, $env) = @_; # Fixes buffer being cut off on redirect when keep-alive is active my $res = $self->app->($env); Plack::Util::response_cb($res, sub { my $res = shift; if ($res->[0] =~ m!^30[123]$! ) { Plack::Util::header_remove($res->[1], 'Content-Length'); Plack::Util::header_remove($res->[1], 'Content-Type'); return sub{ my $chunk; return unless defined $chunk; return ''; }; } return; }); } 1; __END__ =head1 NAME Plack::Middleware::IIS7KeepAliveFix - fixes buffer being cut off on redirect when keep-alive is active on IIS. =head1 SYNOPSIS # in your app.psgi use Plack::Builder; builder { enable "IIS7KeepAliveFix"; $app; }; # Or from the command line plackup -s FCGI -e 'enable "IIS7KeepAliveFix"' /path/to/app.psgi =head1 DESCRIPTION This middleware fixes buffer being cut off on redirect when keep-alive is active on IIS7. =head1 AUTHORS KnowZeroX =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/JSONP.pm����������������������������������������������������������000644 �000765 �000024 �00000003447 12631015706 020717� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::JSONP; use strict; use parent qw(Plack::Middleware); use Plack::Util; use URI::Escape (); use Plack::Util::Accessor qw/callback_key/; sub prepare_app { my $self = shift; unless (defined $self->callback_key) { $self->callback_key('callback'); } } sub call { my($self, $env) = @_; my $res = $self->app->($env); $self->response_cb($res, sub { my $res = shift; if (defined $res->[2]) { my $h = Plack::Util::headers($res->[1]); my $callback_key = $self->callback_key; if ($h->get('Content-Type') =~ m!/(?:json|javascript)! && $env->{QUERY_STRING} =~ /(?:^|&)$callback_key=([^&]+)/) { my $cb = URI::Escape::uri_unescape($1); if ($cb =~ /^[\w\.\[\]]+$/) { my $body; Plack::Util::foreach($res->[2], sub { $body .= $_[0] }); my $jsonp = "/**/$cb($body)"; $res->[2] = [ $jsonp ]; $h->set('Content-Length', length $jsonp); $h->set('Content-Type', 'text/javascript'); } } } }); } 1; __END__ =head1 NAME Plack::Middleware::JSONP - Wraps JSON response in JSONP if callback parameter is specified =head1 SYNOPSIS enable "JSONP", callback_key => 'jsonp'; =head1 DESCRIPTION Plack::Middleware::JSONP wraps JSON response, which has Content-Type value either C<text/javascript> or C<application/json> as a JSONP response which is specified with the C<callback> query parameter. The name of the parameter can be set while enabling the middleware. This middleware only works with a non-streaming response, and doesn't touch the response otherwise. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/LighttpdScriptNameFix.pm������������������������������������������000644 �000765 �000024 �00000004370 12631015706 024236� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::LighttpdScriptNameFix; use strict; use parent qw/Plack::Middleware/; use Plack::Util::Accessor qw(script_name); sub prepare_app { my $self = shift; my $script_name = $self->script_name; $script_name = '' unless defined($script_name); $script_name =~ s!/$!!; $self->script_name($script_name); } sub call { my($self, $env) = @_; if ($env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ /lighttpd/) { $env->{PATH_INFO} = $env->{SCRIPT_NAME} . $env->{PATH_INFO}; $env->{SCRIPT_NAME} = $self->script_name; $env->{PATH_INFO} =~ s/^\Q$env->{SCRIPT_NAME}\E//; } return $self->app->($env); } 1; __END__ =head1 NAME Plack::Middleware::LighttpdScriptNameFix - fixes wrong SCRIPT_NAME and PATH_INFO that lighttpd sets =head1 SYNOPSIS # in your app.psgi use Plack::Builder; builder { enable "LighttpdScriptNameFix"; $app; }; # Or from the command line plackup -s FCGI -e 'enable "LighttpdScriptNameFix"' /path/to/app.psgi =head1 DESCRIPTION This middleware fixes wrong C<SCRIPT_NAME> and C<PATH_INFO> set by lighttpd when you mount your app under the root path ("/"). If you use lighttpd 1.4.23 or later you can instead enable C<fix-root-scriptname> flag inside C<fastcgi.server> instead of using this middleware. =head1 CONFIGURATION =over 4 =item script_name Even with C<fix-root-scriptname>, lighttpd I<still> sets weird C<SCRIPT_NAME> and C<PATH_INFO> if you mount your application at C<""> or something that ends with C</>. Setting C<script_name> option tells the middleware how to reconstruct the new correct C<SCRIPT_NAME> and C<PATH_INFO>. If you mount the app under C</something/>, you should set: enable "LighttpdScriptNameFix", script_name => "/something"; and when a request for C</something/a/b?param=1> comes, C<SCRIPT_NAME> becomes C</something> and C<PATH_INFO> becomes C</a/b>. C<script_name> option is set to empty by default, which means all the request path is set to C<PATH_INFO> and it behaves like your fastcgi application is mounted in the root path. =back =head1 AUTHORS Yury Zavarin Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::Handler::FCGI> L<http://github.com/plack/Plack/issues#issue/68> L<https://redmine.lighttpd.net/issues/729> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Lint.pm�����������������������������������������������������������000644 �000765 �000024 �00000016011 12631015706 020723� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Lint; use strict; no warnings; use Carp (); use parent qw(Plack::Middleware); use Scalar::Util qw(blessed); use Plack::Util; sub wrap { my($self, $app) = @_; unless (ref $app eq 'CODE' or overload::Method($app, '&{}')) { die("PSGI app should be a code reference: ", (defined $app ? $app : "undef")); } $self->SUPER::wrap($app); } sub call { my $self = shift; my $env = shift; $self->validate_env($env); my $res = $self->app->($env); return $self->validate_res($res); } sub validate_env { my ($self, $env) = @_; unless ($env->{REQUEST_METHOD}) { die('Missing env param: REQUEST_METHOD'); } unless ($env->{REQUEST_METHOD} =~ /^[A-Z]+$/) { die("Invalid env param: REQUEST_METHOD($env->{REQUEST_METHOD})"); } unless (defined($env->{SCRIPT_NAME})) { # allows empty string die('Missing mandatory env param: SCRIPT_NAME'); } if ($env->{SCRIPT_NAME} eq '/') { die('SCRIPT_NAME must not be /'); } unless (defined($env->{PATH_INFO})) { # allows empty string die('Missing mandatory env param: PATH_INFO'); } if ($env->{PATH_INFO} ne '' && $env->{PATH_INFO} !~ m!^/!) { die('PATH_INFO must begin with / ($env->{PATH_INFO})'); } unless (defined($env->{SERVER_NAME})) { die('Missing mandatory env param: SERVER_NAME'); } if ($env->{SERVER_NAME} eq '') { die('SERVER_NAME must not be empty string'); } unless (defined($env->{SERVER_PORT})) { die('Missing mandatory env param: SERVER_PORT'); } if ($env->{SERVER_PORT} eq '') { die('SERVER_PORT must not be empty string'); } if (defined($env->{SERVER_PROTOCOL}) and $env->{SERVER_PROTOCOL} !~ m{^HTTP/\d}) { die("Invalid SERVER_PROTOCOL: $env->{SERVER_PROTOCOL}"); } for my $param (qw/version url_scheme input errors multithread multiprocess/) { unless (exists $env->{"psgi.$param"}) { die("Missing psgi.$param"); } } unless (ref($env->{'psgi.version'}) eq 'ARRAY') { die("psgi.version should be ArrayRef: $env->{'psgi.version'}"); } unless (scalar(@{$env->{'psgi.version'}}) == 2) { die('psgi.version should contain 2 elements, not ', scalar(@{$env->{'psgi.version'}})); } unless ($env->{'psgi.url_scheme'} =~ /^https?$/) { die("psgi.url_scheme should be 'http' or 'https': ", $env->{'psgi.url_scheme'}); } if ($env->{"psgi.version"}->[1] == 1) { # 1.1 for my $param (qw(streaming nonblocking run_once)) { unless (exists $env->{"psgi.$param"}) { die("Missing psgi.$param"); } } } if ($env->{HTTP_CONTENT_TYPE}) { die('HTTP_CONTENT_TYPE should not exist'); } if ($env->{HTTP_CONTENT_LENGTH}) { die('HTTP_CONTENT_LENGTH should not exist'); } } sub is_possibly_fh { my $fh = shift; ref $fh eq 'GLOB' && *{$fh}{IO} && *{$fh}{IO}->can('getline'); } sub validate_res { my ($self, $res, $streaming) = @_; unless (ref($res) eq 'ARRAY' or ref($res) eq 'CODE') { die("Response should be array ref or code ref: $res"); } if (ref $res eq 'CODE') { return $self->response_cb($res, sub { $self->validate_res(@_, 1) }); } unless (@$res == 3 || ($streaming && @$res == 2)) { die('Response needs to be 3 element array, or 2 element in streaming'); } unless ($res->[0] =~ /^\d+$/ && $res->[0] >= 100) { die("Status code needs to be an integer greater than or equal to 100: $res->[0]"); } unless (ref $res->[1] eq 'ARRAY') { die("Headers needs to be an array ref: $res->[1]"); } my @copy = @{$res->[1]}; unless (@copy % 2 == 0) { die('The number of response headers needs to be even, not odd(', scalar(@copy), ')'); } while(my($key, $val) = splice(@copy, 0, 2)) { if (lc $key eq 'status') { die('Response headers MUST NOT contain a key named Status'); } if ($key =~ /[:\r\n]|[-_]$/) { die("Response headers MUST NOT contain a key with : or newlines, or that end in - or _: $key"); } unless ($key =~ /^[a-zA-Z][0-9a-zA-Z\-_]*$/) { die("Response headers MUST consist only of letters, digits, _ or - and MUST start with a letter: $key"); } if ($val =~ /[\000-\037]/) { die("Response headers MUST NOT contain characters below octal \037: $val"); } if (!defined $val) { die("Response headers MUST be a defined string"); } } # @$res == 2 is only right in psgi.streaming, and it's already checked. unless (@$res == 2 || ref $res->[2] eq 'ARRAY' || Plack::Util::is_real_fh($res->[2]) || is_possibly_fh($res->[2]) || (blessed($res->[2]) && $res->[2]->can('getline'))) { die("Body should be an array ref or filehandle: $res->[2]"); } if (ref $res->[2] eq 'ARRAY' && grep _has_wide_char($_), @{$res->[2]}) { die("Body must be bytes and should not contain wide characters (UTF-8 strings)"); } return $res; } # NOTE: Some modules like HTML:: or XML:: could possibly generate # ASCII/Latin-1 strings with utf8 flags on. They're actually safe to # print, so there's no need to give warnings about it. sub _has_wide_char { my $str = shift; utf8::is_utf8($str) && $str =~ /[^\x00-\xff]/; } 1; __END__ =head1 NAME Plack::Middleware::Lint - Validate request and response =head1 SYNOPSIS use Plack::Middleware::Lint; my $app = sub { ... }; # your app or middleware $app = Plack::Middleware::Lint->wrap($app); # Or from plackup plackup -e 'enable "Lint"' myapp.psgi =head1 DESCRIPTION Plack::Middleware::Lint is a middleware component to validate request and response environment formats. You are strongly suggested to use this middleware when you develop a new framework adapter or a new PSGI web server that implements the PSGI interface. This middleware is enabled by default when you run plackup or other launcher tools with the default environment I<development> value. =head1 DEBUGGING Because of how this middleware works, it may not be easy to debug Lint errors when you encounter one, unless you're writing a PSGI web server or a framework. For example, when you're an application developer (user of some framework) and see errors like: Body should be an array ref or filehandle at lib/Plack/Middleware/Lint.pm line XXXX there's no clue about which line of I<your application> produces that error. We're aware of the issue, and have a plan to spit out more helpful errors to diagnose the issue. But until then, currently there are some workarounds to make this easier. For now, the easiest one would be to enable L<Plack::Middleware::REPL> outside of the Lint middleware, like: plackup -e 'enable "REPL"; enable "Lint"' app.psgi so that the Lint errors are caught by the REPL shell, where you can inspect all the variables in the response. =head1 AUTHOR Tatsuhiko Miyagawa Tokuhiro Matsuno =head1 SEE ALSO L<Plack> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Log4perl.pm�������������������������������������������������������000644 �000765 �000024 �00000004067 12631015706 021515� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Log4perl; use strict; use parent qw(Plack::Middleware); use Plack::Util::Accessor qw(category logger conf); use Carp (); sub prepare_app { my $self = shift; if ($self->conf) { require Log::Log4perl; Log::Log4perl::init($self->conf); } # NOTICE: if category = '0' you must not change it by '' (root logger) $self->logger( Log::Log4perl->get_logger( defined $self->category ? $self->category : '' ) ); } sub call { my($self, $env) = @_; $env->{'psgix.logger'} = sub { my $args = shift; my $level = $args->{level}; local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 1; $self->logger->$level($args->{message}); }; $self->app->($env); } 1; __END__ =head1 NAME Plack::Middleware::Log4perl - Uses Log::Log4perl to configure logger =head1 SYNOPSIS my $app = sub { my $env = shift; $env->{'psgix.logger'}({ level => 'error', message => 'Hi' }); return [ '200', [ 'Content-Type' => 'text/plain' ], [ "Hello World" ], ]; }; # Use your own Log4perl configuration use Log::Log4perl; Log::Log4perl::init('/path/to/log4perl.conf'); builder { # tell the logger to log with 'plack' category enable "Log4perl", category => "plack"; $app; } # Configure with Log4perl middleware options builder { enable "Log4perl", category => "plack", conf => '/path/to/log4perl.conf'; $app; } =head1 DESCRIPTION Log4perl is a L<Plack::Middleware> component that allows you to use L<Log::Log4perl> to configure the logging object C<psgix.logger> for a given category. =head1 CONFIGURATION =over 4 =item category The C<log4perl> category to send logs to. Defaults to C<''> which means it send to the root logger. =item conf The configuration file path (or a scalar ref containing the config string) for L<Log::Log4perl> to automatically configure. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Log::Log4perl> L<Plack::Middleware::LogDispatch> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/LogDispatch.pm����������������������������������������������������000644 �000765 �000024 �00000003044 12631015706 022220� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::LogDispatch; use strict; use parent qw(Plack::Middleware); use Plack::Util::Accessor qw(logger); use Carp (); sub prepare_app { my $self = shift; unless ($self->logger) { Carp::croak "logger is not defined"; } } sub call { my($self, $env) = @_; $env->{'psgix.logger'} = sub { my $args = shift; $args->{level} = 'critical' if $args->{level} eq 'fatal'; if ( ref $args->{message} && ref $args->{message} ne 'CODE' ) { $args->{message} .= q{}; } $self->logger->log(%$args); }; $self->app->($env); } 1; __END__ =head1 NAME Plack::Middleware::LogDispatch - Uses Log::Dispatch to configure logger =head1 SYNOPSIS use Log::Dispatch; my $logger = Log::Dispatch->new; $logger->add( Log::Dispatch::File->new(...) ); $logger->add( Log::Dispatch::DesktopNotification->new(...) ); builder { enable "LogDispatch", logger => $logger; $app; } # use with Log::Dispatch::Config use Log::Dispatch::Config; Log::Dispatch::Config->configure('/path/to/log.conf'); builder { enable "LogDispatch", logger => Log::Dispatch::Config->instance; ... } =head1 DESCRIPTION LogDispatch is a L<Plack::Middleware> component that allows you to use L<Log::Dispatch> to configure the logging object, C<psgix.logger>. =head1 CONFIGURATION =over 4 =item logger L<Log::Dispatch> object to send logs to. Required. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Log::Dispatch> L<Plack::Middleware::Log4perl> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/NullLogger.pm�����������������������������������������������������000644 �000765 �000024 �00000001027 12631015706 022070� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::NullLogger; use strict; use parent qw/Plack::Middleware/; sub call { my($self, $env) = @_; $env->{'psgix.logger'} = sub { }; $self->app->($env); } 1; __END__ =head1 NAME Plack::Middleware::NullLogger - Send logs to /dev/null =head1 SYNOPSIS enable "NullLogger"; =head1 DESCRIPTION NullLogger is a middleware component that receives logs and does nothing but discarding them. Might be useful to shut up all the logs from frameworks in one shot. =head1 AUTHOR Tatsuhiko Miyagawa =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/RearrangeHeaders.pm�����������������������������������������������000644 �000765 �000024 �00000002617 12631015706 023226� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::RearrangeHeaders; use strict; use warnings; use parent qw( Plack::Middleware ); use HTTP::Headers; sub call { my $self = shift; my $res = $self->app->(@_); $self->response_cb($res, sub { my $res = shift; my $h = HTTP::Headers->new(@{$res->[1]}); my @new_headers; $h->scan(sub { push @new_headers, @_ }); $res->[1] = \@new_headers; }); } 1; __END__ =head1 NAME Plack::Middleware::RearrangeHeaders - Reorder HTTP headers for buggy clients =head1 SYNOPSIS use Plack::Builder; my $app = sub { return [ 200, [ 'Last-Modified' => 'Wed, 23 Sep 2009 13:36:33 GMT', 'Content-Type' => 'text/plain', 'ETag' => 'foo bar', ], [ 'Hello Foo' ] ]; }; builder { enable "Plack::Middleware::RearrangeHeaders"; $app; }; =head1 DESCRIPTION Plack::Middleware::RearrangeHeaders sorts HTTP headers based on "Good Practice" i.e.: # "Good Practice" order of HTTP message headers: # - Response-Headers # - Entity-Headers to work around buggy clients like very old MSIE or broken HTTP proxy servers. Most clients today don't (and shouldn't) care about HTTP header order but if you're too pedantic or have some environments where you need to deal with buggy clients like above, this might be useful. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<HTTP::Headers> =cut �����������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Recursive.pm������������������������������������������������������000644 �000765 �000024 �00000006740 12631015706 021774� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Recursive; use strict; use parent qw(Plack::Middleware); use Try::Tiny; use Scalar::Util qw(blessed); open my $null_io, "<", \""; sub call { my($self, $env) = @_; $env->{'plack.recursive.include'} = $self->recurse_callback($env, 1); my $res = try { $self->app->($env); } catch { if (blessed $_ && $_->isa('Plack::Recursive::ForwardRequest')) { return $self->recurse_callback($env)->($_->path); } else { die $_; # rethrow } }; return $res if ref $res eq 'ARRAY'; return sub { my $respond = shift; my $writer; try { $res->(sub { return $writer = $respond->(@_) }); } catch { if (!$writer && blessed $_ && $_->isa('Plack::Recursive::ForwardRequest')) { $res = $self->recurse_callback($env)->($_->path); return ref $res eq 'CODE' ? $res->($respond) : $respond->($res); } else { die $_; } }; }; } sub recurse_callback { my($self, $env, $include) = @_; my $old_path_info = $env->{PATH_INFO}; return sub { my $new_path_info = shift; my($path, $query) = split /\?/, $new_path_info, 2; Scalar::Util::weaken($env); $env->{PATH_INFO} = $path; $env->{QUERY_STRING} = $query; $env->{REQUEST_METHOD} = 'GET'; $env->{CONTENT_LENGTH} = 0; $env->{CONTENT_TYPE} = ''; $env->{'psgi.input'} = $null_io; push @{$env->{'plack.recursive.old_path_info'}}, $old_path_info; $include ? $self->app->($env) : $self->call($env); }; } package Plack::Recursive::ForwardRequest; use overload q("") => \&as_string, fallback => 1; sub new { my($class, $path) = @_; bless { path => $path }, $class; } sub path { $_[0]->{path} } sub throw { my($class, @args) = @_; die $class->new(@args); } sub as_string { my $self = shift; return "Forwarding to $self->{path}: Your application should be wrapped with Plack::Middleware::Recursive."; } package Plack::Middleware::Recursive; 1; __END__ =head1 NAME Plack::Middleware::Recursive - Allows PSGI apps to include or forward requests recursively =head1 SYNOPSIS # with Builder enable "Recursive"; # in apps my $res = $env->{'plack.recursive.include'}->("/new_path"); # Or, use exceptions my $app = sub { # ... Plack::Recursive::ForwardRequest->throw("/new_path"); }; =head1 DESCRIPTION Plack::Middleware::Recursive allows PSGI applications to recursively include or forward requests to other paths. Applications can make use of callbacks stored in C<< $env->{'plack.recursive.include'} >> to I<include> another path to get the response (whether it's an array ref or a code ref depending on your application), or throw an exception Plack::Recursive::ForwardRequest anywhere in the code to I<forward> the current request (i.e. abort the current and redo the request). =head1 EXCEPTIONS This middleware passes through unknown exceptions to the outside middleware stack, so if you use this middleware with other exception handlers such as L<Plack::Middleware::StackTrace> or L<Plack::Middleware::HTTPExceptions>, be sure to wrap this so L<Plack::Middleware::Recursive> gets as inner as possible. =head1 AUTHORS Tatsuhiko Miyagawa Masahiro Honma =head1 SEE ALSO L<Plack> L<Plack::Middleware::HTTPExceptions> The idea, code and interface are stolen from Rack::Recursive and paste.recursive. =cut ��������������������������������Plack-1.0039/lib/Plack/Middleware/Refresh.pm��������������������������������������������������������000644 �000765 �000024 �00000003051 12631015706 021413� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Refresh; use strict; use parent qw(Plack::Middleware); use Module::Refresh; use Plack::Util::Accessor qw(last cooldown); sub prepare_app { my $self = shift; $self->cooldown(10) unless defined $self->cooldown; Module::Refresh->new; $self->last(time - $self->cooldown); } sub call { my($self, $env) = @_; if (time > $self->last + $self->cooldown) { Module::Refresh->refresh; $self->last(time); } $self->app->($env); } 1; __END__ =head1 NAME Plack::Middleware::Refresh - Refresh all modules in %INC =head1 SYNOPSIS enable "Refresh", cooldown => 3; $app; =head1 DESCRIPTION This is I<yet another> approach to refresh modules in C<%INC> during the development cycle, without the need to have a forking process to watch for filesystem updates. This middleware, in a request time, compares the last refresh time and the current time and if the difference is bigger than I<cooldown> seconds which defaults to 10, call L<Module::Refresh> to reload all Perl modules in C<%INC> if the files have been modified. Note that this only reloads modules and not other files such as templates. This middleware is quite similar to what Rack::Reoader does. If you have issues with this reloading technique, for instance when you have in-file templates that needs to be recompiled, or Moose classes that has C<make_immutable>, take a look at L<plackup>'s default -r option or L<Plack::Loader::Shotgun> instead. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Module::Refresh> Rack::Reloader =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Runtime.pm��������������������������������������������������������000644 �000765 �000024 �00000002006 12631015706 021437� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Runtime; use strict; use parent qw(Plack::Middleware); use Plack::Util; use Plack::Util::Accessor qw(header_name); use Time::HiRes; sub call { my($self, $env) = @_; my $start = [ Time::HiRes::gettimeofday ]; my $res = $self->app->($env); my $header = $self->header_name || 'X-Runtime'; $self->response_cb($res, sub { my $res = shift; my $req_time = sprintf '%.6f', Time::HiRes::tv_interval($start); Plack::Util::header_set($res->[1], $header, $req_time); }); } 1; __END__ =head1 NAME Plack::Middleware::Runtime - Sets an X-Runtime response header =head1 SYNOPSIS enable "Runtime"; =head1 DESCRIPTION Plack::Middleware::Runtime is a Plack middleware component that sets the application's response time (in seconds) in the I<X-Runtime> HTTP response header. =head1 OPTIONS =over 4 =item header_name Name of the header. Defaults to I<X-Runtime>. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Time::HiRes> Rack::Runtime =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/SimpleContentFilter.pm��������������������������������������������000644 �000765 �000024 �00000002641 12631015706 023753� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::SimpleContentFilter; use strict; use warnings; use parent qw( Plack::Middleware ); use Plack::Util; use Plack::Util::Accessor qw( filter ); sub call { my $self = shift; my $res = $self->app->(@_); $self->response_cb($res, sub { my $res = shift; my $h = Plack::Util::headers($res->[1]); return unless $h->get('Content-Type'); if ($h->get('Content-Type') =~ m!^text/!) { return sub { my $chunk = shift; return unless defined $chunk; local $_ = $chunk; $self->filter->(); return $_; }; } }); } 1; __END__ =head1 NAME Plack::Middleware::SimpleContentFilter - Filters response content =head1 SYNOPSIS use Plack::Builder; my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; }; builder { enable "Plack::Middleware::SimpleContentFilter", filter => sub { s/Foo/Bar/g; }; $app; }; =head1 DESCRIPTION B<This middleware should be considered as a demo. Running this against your application might break your HTML unless you code the filter callback carefully>. Plack::Middleware::SimpleContentFilter is a simple content text filter to run against response body. This middleware is only enabled against responses with C<text/*> Content-Type. =head1 AUTHOR Tatsuhiko Miyagawa =cut �����������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/SimpleLogger.pm���������������������������������������������������000644 �000765 �000024 �00000003374 12631015706 022416� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::SimpleLogger; use strict; use parent qw(Plack::Middleware); use Config (); use Plack::Util::Accessor qw(level); use POSIX (); use Scalar::Util (); # Should this be in Plack::Util? my $i = 0; my %level_numbers = map { $_ => $i++ } qw(debug info warn error fatal); sub call { my($self, $env) = @_; my $min = $level_numbers{ $self->level || "debug" }; my $env_ref = $env; Scalar::Util::weaken($env_ref); $env->{'psgix.logger'} = sub { my $args = shift; if ($level_numbers{$args->{level}} >= $min) { $env_ref->{'psgi.errors'}->print($self->format_message($args->{level}, $args->{message})); } }; $self->app->($env); } sub format_time { my $old_locale; if ( $Config::config{d_setlocale} ) { $old_locale = POSIX::setlocale(&POSIX::LC_ALL); POSIX::setlocale(&POSIX::LC_ALL, 'C'); } my $out = POSIX::strftime(@_); if ( $Config::config{d_setlocale} ) { POSIX::setlocale(&POSIX::LC_ALL, $old_locale); }; return $out; } sub format_message { my($self, $level, $message) = @_; my $time = format_time("%Y-%m-%dT%H:%M:%S", localtime); sprintf "%s [%s #%d] %s: %s\n", uc substr($level, 0, 1), $time, $$, uc $level, $message; } 1; __END__ =head1 NAME Plack::Middleware::SimpleLogger - Simple logger that prints to psgi.errors =head1 SYNOPSIS enable "SimpleLogger", level => "warn"; =head1 DESCRIPTION SimpleLogger is a middleware component that formats the log message with information such as the time and PID and prints them to I<psgi.errors> stream, which is mostly STDERR or server log output. =head1 SEE ALSO L<Plack::Middleware::LogErrors>, essentially the opposite of this module =head1 AUTHOR Tatsuhiko Miyagawa =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/StackTrace.pm�����������������������������������������������������000644 �000765 �000024 �00000015070 12631015706 022045� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::StackTrace; use strict; use warnings; use parent qw/Plack::Middleware/; use Devel::StackTrace; use Devel::StackTrace::AsHTML; use Scalar::Util qw( refaddr ); use Try::Tiny; use Plack::Util::Accessor qw( force no_print_errors ); our $StackTraceClass = "Devel::StackTrace"; # Optional since it needs PadWalker if (try { require Devel::StackTrace::WithLexicals; Devel::StackTrace::WithLexicals->VERSION(0.08); 1 }) { $StackTraceClass = "Devel::StackTrace::WithLexicals"; } sub call { my($self, $env) = @_; my ($trace, %string_traces, %ref_traces); local $SIG{__DIE__} = sub { $trace = $StackTraceClass->new( indent => 1, message => munge_error($_[0], [ caller ]), ignore_package => __PACKAGE__, no_refs => 1, ); if (ref $_[0]) { $ref_traces{refaddr($_[0])} ||= $trace; } else { $string_traces{$_[0]} ||= $trace; } die @_; }; my $caught; my $res = try { $self->app->($env); } catch { $caught = $_; [ 500, [ "Content-Type", "text/plain; charset=utf-8" ], [ no_trace_error(utf8_safe($caught)) ] ]; }; if ($caught) { # Try to find the correct trace for the caught exception my $caught_trace; if (ref $caught) { $caught_trace = $ref_traces{refaddr($caught)}; } else { # This is not guaranteed to work if multiple exceptions with # the same message are thrown. $caught_trace = $string_traces{$caught}; } $trace = $caught_trace if $caught_trace; } if ($trace && ($caught || ($self->force && ref $res eq 'ARRAY' && $res->[0] == 500)) ) { my $text = $trace->as_string; my $html = $trace->as_html; $env->{'plack.stacktrace.text'} = $text; $env->{'plack.stacktrace.html'} = $html; $env->{'psgi.errors'}->print($text) unless $self->no_print_errors; if (($env->{HTTP_ACCEPT} || '*/*') =~ /html/) { $res = [500, ['Content-Type' => 'text/html; charset=utf-8'], [ utf8_safe($html) ]]; } else { $res = [500, ['Content-Type' => 'text/plain; charset=utf-8'], [ utf8_safe($text) ]]; } } # break $trace here since $SIG{__DIE__} holds the ref to it, and # $trace has refs to Standalone.pm's args ($conn etc.) and # prevents garbage collection to be happening. undef $trace; return $res; } sub no_trace_error { my $msg = shift; chomp($msg); return <<EOF; The application raised the following error: $msg and the StackTrace middleware couldn't catch its stack trace, possibly because your application overrides \$SIG{__DIE__} by itself, preventing the middleware from working correctly. Remove the offending code or module that does it: known examples are CGI::Carp and Carp::Always. EOF } sub munge_error { my($err, $caller) = @_; return $err if ref $err; # Ugly hack to remove " at ... line ..." automatically appended by perl # If there's a proper way to do this, please let me know. $err =~ s/ at \Q$caller->[1]\E line $caller->[2]\.\n$//; return $err; } sub utf8_safe { my $str = shift; # NOTE: I know messing with utf8:: in the code is WRONG, but # because we're running someone else's code that we can't # guarantee which encoding an exception is encoded, there's no # better way than doing this. The latest Devel::StackTrace::AsHTML # (0.08 or later) encodes high-bit chars as HTML entities, so this # path won't be executed. if (utf8::is_utf8($str)) { utf8::encode($str); } $str; } 1; __END__ =head1 NAME Plack::Middleware::StackTrace - Displays stack trace when your app dies =head1 SYNOPSIS enable "StackTrace"; =head1 DESCRIPTION This middleware uses C<$SIG{__DIE__}> to intercept I<all> exceptions (run-time errors) happening in your application, even those that are caught. For each exception it builds a detailed stack trace. If the applications aborts by throwing an exception it will be caught and matched against the saved stack traces. If a match is found it will be displayed as a nice stack trace screen, if not then the exception will be reported without a stack trace. The stack trace is also stored in the environment as a plaintext and HTML under the key C<plack.stacktrace.text> and C<plack.stacktrace.html> respectively, so that middleware further up the stack can reference it. This middleware is enabled by default when you run L<plackup> in the default I<development> mode. You're recommended to use this middleware during the development and use L<Plack::Middleware::HTTPExceptions> in the deployment mode as a replacement, so that all the exceptions thrown from your application still get caught and rendered as a 500 error response, rather than crashing the web server. Catching errors in streaming response is not supported. =head2 Stack Trace Module The L<Devel::StackTrace::WithLexicals> module will be used to capture the stack trace if the installed version is 0.08 or later. Otherwise L<Devel::StackTrace> is used. =head2 Performance Gathering the information for a stack trace via L<Devel::StackTrace> is slow, and L<Devel::StackTrace::WithLexicals> is significantly slower still. This is not usually a concern in development and when exceptions are rare. However, your application may include code that's throwing and catching exceptions that you're not aware of. Such code will run I<significantly> slower with this module. =head1 CONFIGURATION =over 4 =item force enable "StackTrace", force => 1; Force display the stack trace when an error occurs within your application and the response code from your application is 500. Defaults to off. The use case of this option is that when your framework catches all the exceptions in the main handler and returns all failures in your code as a normal 500 PSGI error response. In such cases, this middleware would never have a chance to display errors because it can't tell if it's an application error or just random C<eval> in your code. This option enforces the middleware to display stack trace even if it's not the direct error thrown by the application. =item no_print_errors enable "StackTrace", no_print_errors => 1; Skips printing the text stacktrace to console (C<psgi.errors>). Defaults to 0, which means the text version of the stack trace error is printed to the errors handle, which usually is a standard error. =back =head1 AUTHOR Tokuhiro Matsuno Tatsuhiko Miyagawa =head1 SEE ALSO L<Devel::StackTrace::AsHTML> L<Plack::Middleware> L<Plack::Middleware::HTTPExceptions> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Static.pm���������������������������������������������������������000644 �000765 �000024 �00000010402 12631015706 021242� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Static; use strict; use warnings; use parent qw/Plack::Middleware/; use Plack::App::File; use Plack::Util::Accessor qw( path root encoding pass_through content_type ); sub call { my $self = shift; my $env = shift; my $res = $self->_handle_static($env); if ($res && not ($self->pass_through and $res->[0] == 404)) { return $res; } return $self->app->($env); } sub _handle_static { my($self, $env) = @_; my $path_match = $self->path or return; my $path = $env->{PATH_INFO}; for ($path) { my $matched = 'CODE' eq ref $path_match ? $path_match->($_, $env) : $_ =~ $path_match; return unless $matched; } $self->{file} ||= Plack::App::File->new({ root => $self->root || '.', encoding => $self->encoding, content_type => $self->content_type }); local $env->{PATH_INFO} = $path; # rewrite PATH return $self->{file}->call($env); } 1; __END__ =head1 NAME Plack::Middleware::Static - serve static files with Plack =head1 SYNOPSIS use Plack::Builder; builder { enable "Plack::Middleware::Static", path => qr{^/(images|js|css)/}, root => './htdocs/'; $app; }; =head1 DESCRIPTION This middleware allows your Plack-based application to serve static files. Note that if you are building an app using L<Plack::App::URLMap>, you should consider using L<Plack::App::File> to serve static files instead. This makes the overall routing of your application simpler to understand. With this middleware, if a static file exists for the requested path, it will be served. If it does not exist, by default this middleware returns a 404, but you can set the C<pass_through> option to change this behavior. If the requested document is not within the C<root> or the file is there but not readable, this middleware will return a 403 Forbidden response. The content type returned will be determined from the file extension by using L<Plack::MIME> or using C<content_type>. =head1 CONFIGURATIONS =over 4 =item path, root enable "Plack::Middleware::Static", path => qr{^/static/}, root => 'htdocs/'; The C<path> option specifies the URL pattern (regular expression) or a callback to match against requests. If the <path> option matches, the middleware looks in C<root> to find the static files to serve. The default value of C<root> is the current directory. This example configuration serves C</static/foo.jpg> from C<htdocs/static/foo.jpg>. Note that the matched portion of the path, C</static/>, still appears in the locally mapped path under C<root>. If you don't want this to happen, you can use a callback to munge the path as you match it: enable "Plack::Middleware::Static", path => sub { s!^/static/!! }, root => 'static-files/'; The callback should operate on C<$_> and return a true or false value. Any changes it makes to C<$_> are used when looking for the static file in the C<root>. The configuration above serves C</static/foo.png> from C<static-files/foo.png>, not C<static-files/static/foo.png>. The callback specified in the C<path> option matches against C<$_> munges this value using C<s///>. The substitution operator returns the number of matches it made, so it will return true when the path matches C<^/static>. For more complex static handling in the C<path> callback, in addition to C<$_> being set the callback receives two arguments, C<PATH_INFO> (same as C<$_>) and C<$env>. If you want to map multiple static directories from different roots, simply add this middleware multiple times with different configuration options. =item pass_through When this option is set to a true value, then this middleware will never return a 404 if it cannot find a matching file. Instead, it will simply pass the request on to the application it is wrapping. =item content_type The C<content_type> option can be used to provide access to a different MIME database than L<Plack::MIME>. L<Plack::MIME> works fast and good for a list of well known file endings, but if you need a more accurate content based checking you can use modules like L<File::MimeInfo> or L<File::MMagic> for example. The callback should work on $_[0] which is the filename of the file. =back =head1 AUTHOR Tokuhiro Matsuno, Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::Middleware> L<Plack::Builder> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/XFramework.pm�����������������������������������������������������000644 �000765 �000024 �00000001573 12631015706 022111� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::XFramework; use strict; use warnings; use parent qw/Plack::Middleware/; use Plack::Util; use Plack::Util::Accessor qw( framework ); sub call { my $self = shift; my $res = $self->app->( @_ ); $self->response_cb($res, sub { my $res = shift; if ($self->framework) { Plack::Util::header_set $res->[1], 'X-Framework' => $self->framework; } }); } 1; __END__ =head1 NAME Plack::Middleware::XFramework - Sample middleware to add X-Framework =head1 SYNOPSIS enable "Plack::Middleware::XFramework", framework => "Catalyst"; =head1 DESCRIPTION This middleware adds C<X-Framework> header to the HTTP response. =head1 CONFIGURATION =over 4 =item framework Sets the string value of C<X-Framework> header. If not set, the header is not set to the response. =back =head1 SEE ALSO L<Plack::Middleware> =cut �������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/XSendfile.pm������������������������������������������������������000644 �000765 �000024 �00000004155 12631015706 021704� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::XSendfile; use strict; use warnings; use parent qw(Plack::Middleware); use Plack::Util; use Scalar::Util; use Plack::Util::Accessor qw( variation ); sub call { my $self = shift; my $env = shift; my $res = $self->app->($env); $self->response_cb($res, sub { my $res = shift; my($status, $headers, $body) = @$res; return unless defined $body; if (Scalar::Util::blessed($body) && $body->can('path')) { my $type = $self->_variation($env) || ''; my $h = Plack::Util::headers($headers); if ($type && !$h->exists($type)) { if ($type eq 'X-Accel-Redirect') { my $path = $body->path; my $url = $self->map_accel_path($env, $path); $h->set($type => $url) if $url; $body = []; } elsif ($type eq 'X-Sendfile' or $type eq 'X-Lighttpd-Send-File') { my $path = $body->path; $h->set($type => $path) if defined $path; $body = []; } else { $env->{'psgi.errors'}->print("Unknown x-sendfile variation: $type"); } } } @$res = ( $status, $headers, $body ); }); } sub map_accel_path { my($self, $env, $path) = @_; if (my $mapping = $env->{HTTP_X_ACCEL_MAPPING}) { my($internal, $external) = split /=/, $mapping, 2; $path =~ s!^\Q$internal\E!$external!i; } return $path; } sub _variation { my($self, $env) = @_; $self->variation || $env->{'plack.xsendfile.type'} || $env->{HTTP_X_SENDFILE_TYPE}; } 1; __END__ =head1 NAME Plack::Middleware::XSendfile - Sets X-Sendfile (or a like) header for frontends =head1 SYNOPSIS enable "Plack::Middleware::XSendfile"; =head1 DESCRIPTION You should use L<IO::File::WithPath> or L<Plack::Util>'s C<set_io_path> to add C<path> method to an IO object in the body. See L<http://github.com/rack/rack-contrib/blob/master/lib/rack/contrib/sendfile.rb> for the frontend configuration. =head1 AUTHOR Tatsuhiko Miyagawa =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/Auth/Basic.pm�����������������������������������������������������000644 �000765 �000024 �00000006651 12631015706 021750� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::Auth::Basic; use strict; use parent qw(Plack::Middleware); use Plack::Util::Accessor qw( realm authenticator ); use Scalar::Util; use MIME::Base64; sub prepare_app { my $self = shift; my $auth = $self->authenticator or die 'authenticator is not set'; if (Scalar::Util::blessed($auth) && $auth->can('authenticate')) { $self->authenticator(sub { $auth->authenticate(@_[0,1]) }); # because Authen::Simple barfs on 3 params } elsif (ref $auth ne 'CODE') { die 'authenticator should be a code reference or an object that responds to authenticate()'; } } sub call { my($self, $env) = @_; my $auth = $env->{HTTP_AUTHORIZATION} or return $self->unauthorized; # note the 'i' on the regex, as, according to RFC2617 this is a # "case-insensitive token to identify the authentication scheme" if ($auth =~ /^Basic (.*)$/i) { my($user, $pass) = split /:/, (MIME::Base64::decode($1) || ":"), 2; $pass = '' unless defined $pass; if ($self->authenticator->($user, $pass, $env)) { $env->{REMOTE_USER} = $user; return $self->app->($env); } } return $self->unauthorized; } sub unauthorized { my $self = shift; my $body = 'Authorization required'; return [ 401, [ 'Content-Type' => 'text/plain', 'Content-Length' => length $body, 'WWW-Authenticate' => 'Basic realm="' . ($self->realm || "restricted area") . '"' ], [ $body ], ]; } 1; __END__ =head1 NAME Plack::Middleware::Auth::Basic - Simple basic authentication middleware =head1 SYNOPSIS use Plack::Builder; my $app = sub { ... }; builder { enable "Auth::Basic", authenticator => \&authen_cb; $app; }; sub authen_cb { my($username, $password, $env) = @_; return $username eq 'admin' && $password eq 's3cr3t'; } =head1 DESCRIPTION Plack::Middleware::Auth::Basic is a basic authentication handler for Plack. =head1 CONFIGURATION =over 4 =item authenticator A callback function that takes username, password and PSGI environment supplied and returns whether the authentication succeeds. Required. Authenticator can also be an object that responds to C<authenticate> method that takes username and password and returns boolean, so backends for L<Authen::Simple> is perfect to use: use Authen::Simple::LDAP; enable "Auth::Basic", authenticator => Authen::Simple::LDAP->new(...); =item realm Realm name to display in the basic authentication dialog. Defaults to I<restricted area>. =back =head1 LIMITATIONS This middleware expects that the application has a full access to the headers sent by clients in PSGI environment. That is normally the case with standalone Perl PSGI web servers such as L<Starman> or L<HTTP::Server::Simple::PSGI>. However, in a web server configuration where you can't achieve this (i.e. using your application via Apache's mod_cgi), this middleware does not work since your application can't know the value of C<Authorization:> header. If you use Apache as a web server and CGI to run your PSGI application, you can either a) compile Apache with C<-DSECURITY_HOLE_PASS_AUTHORIZATION> option, or b) use mod_rewrite to pass the Authorization header to the application with the rewrite rule like following. RewriteEngine on RewriteRule .* - [E=HTTP_AUTHORIZATION:%{HTTP:Authorization},L] =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack> =cut ���������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Middleware/AccessLog/Timed.pm������������������������������������������������000644 �000765 �000024 �00000005756 12631015706 022740� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Middleware::AccessLog::Timed; use strict; use warnings; use parent qw( Plack::Middleware::AccessLog ); use Time::HiRes; use Plack::Util; sub call { my $self = shift; my($env) = @_; my $time = Time::HiRes::gettimeofday; my $length = 0; my $logger = $self->logger || sub { $env->{'psgi.errors'}->print(@_) }; my $res = $self->app->($env); return $self->response_cb($res, sub { my $res = shift; my($status, $header, $body) = @$res; if (!defined $body) { my $length; return sub { my $line = shift; $length += length $line if defined $line; unless( defined $line ) { my $now = Time::HiRes::gettimeofday; $logger->( $self->log_line($status, $header, $env, { time => $now - $time, content_length => $length }) ); } return $line; }; } my $getline = ref $body eq 'ARRAY' ? sub { shift @$body } : sub { $body->getline }; my $timer_body = Plack::Util::inline_object( getline => sub { my $line = $getline->(); $length += length $line if defined $line; return $line; }, close => sub { $body->close if ref $body ne 'ARRAY'; my $now = Time::HiRes::gettimeofday; $logger->( $self->log_line($status, $header, $env, { time => $now - $time, content_length => $length }) ); }, ); @$res = ($status, $header, $timer_body); }); } 1; __END__ =head1 NAME Plack::Middleware::AccessLog::Timed - Logs requests with time and accurate body size =head1 SYNOPSIS # in app.psgi use Plack::Builder; builder { enable "Plack::Middleware::AccessLog::Timed", format => "%v %h %l %u %t \"%r\" %>s %b %D"; $app; }; =head1 DESCRIPTION Plack::Middleware::AccessLog::Timed is a subclass of L<Plack::Middleware::AccessLog> but uses a wrapped body handle to get the actual response body size C<%b> (even if it's not a chunk of array or a real filehandle) and the time taken to serve the request: C<%T> or C<%D>. This wraps the response body output stream to capture the time taken for the PSGI server to read the whole response body. This would mean, if the middleware is in use, it will prevent some server-side optimizations like sendfile(2) from working, as well as middleware like L<Plack::Middleware::ContentLength> can't guess the body size out of the file handle. If all you want is to capture the time taken in your PSGI application and do not want the wrapped body behavior described above, consider instead applying L<Plack::Middleware::Runtime> and using L<Plack::Middleware::AccessLog> to log the C<X-Runtime> header. =head1 CONFIGURATION Same as L<Plack::Middleware::AccessLog>. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::Middleware::AccessLog> L<Plack::Middleware::Runtime> =cut ������������������Plack-1.0039/lib/Plack/Loader/Delayed.pm������������������������������������������������������������000644 �000765 �000024 �00000003064 12631015706 020521� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Loader::Delayed; use strict; use parent qw(Plack::Loader); sub preload_app { my($self, $builder) = @_; $self->{builder} = $builder; } sub run { my($self, $server) = @_; my $compiled; my $app = sub { $compiled ||= $self->{builder}->(); $compiled->(@_); }; $server->{psgi_app_builder} = $self->{builder}; $server->run($app); } 1; __END__ =head1 NAME Plack::Loader::Delayed - Delay the loading of .psgi until the first run =head1 SYNOPSIS plackup -s Starlet -L Delayed myapp.psgi =head1 DESCRIPTION This loader delays the compilation of specified PSGI application until the first request time. This prevents bad things from happening with preforking web servers like L<Starlet>, when your application manipulates resources such as sockets or database connections in the master startup process and then shared by children. You can combine this loader with C<-M> command line option, like: plackup -s Starlet -MCatalyst -L Delayed myapp.psgi loads the module Catalyst in the master process for the better process management with copy-on-write, however the application C<myapp.psgi> is loaded per children. L<Starman> since version 0.2000 loads this loader by default unless you specify the command line option C<--preload-app> for the L<starman> executable. =head1 DEVELOPERS Web server developers can make use of C<psgi_app_builder> attribute callback set in Plack::Handler, to load the application earlier than the first request time. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<plackup> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Loader/Restarter.pm����������������������������������������������������������000644 �000765 �000024 �00000005027 12631015706 021126� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Loader::Restarter; use strict; use warnings; use parent qw(Plack::Loader); use Plack::Util; use Try::Tiny; sub new { my($class, $runner) = @_; bless { watch => [] }, $class; } sub preload_app { my($self, $builder) = @_; $self->{builder} = $builder; } sub watch { my($self, @dir) = @_; push @{$self->{watch}}, @dir; } sub _fork_and_start { my($self, $server) = @_; delete $self->{pid}; # re-init in case it's a restart my $pid = fork; die "Can't fork: $!" unless defined $pid; if ($pid == 0) { # child return $server->run($self->{builder}->()); } else { $self->{pid} = $pid; } } sub _kill_child { my $self = shift; my $pid = $self->{pid} or return; warn "Killing the existing server (pid:$pid)\n"; kill 'TERM' => $pid; waitpid($pid, 0); } sub valid_file { my($self, $file) = @_; # vim temporary file is 4913 to 5036 # http://www.mail-archive.com/vim_dev@googlegroups.com/msg07518.html if ( $file->{path} =~ m{(\d+)$} && $1 >= 4913 && $1 <= 5036) { return 0; } $file->{path} !~ m!\.(?:git|svn)[/\\]|\.(?:bak|swp|swpx|swx)$|~$|_flymake\.p[lm]$|\.#!; } sub run { my($self, $server) = @_; $self->_fork_and_start($server); return unless $self->{pid}; require Filesys::Notify::Simple; my $watcher = Filesys::Notify::Simple->new($self->{watch}); warn "Watching @{$self->{watch}} for file updates.\n"; local $SIG{TERM} = sub { $self->_kill_child; exit(0); }; while (1) { my @restart; # this is blocking $watcher->wait(sub { my @events = @_; @events = grep $self->valid_file($_), @events; return unless @events; @restart = @events; }); next unless @restart; for my $ev (@restart) { warn "-- $ev->{path} updated.\n"; } $self->_kill_child; warn "Successfully killed! Restarting the new server process.\n"; $self->_fork_and_start($server); return unless $self->{pid}; } } 1; __END__ =head1 NAME Plack::Loader::Restarter - Restarting loader =head1 SYNOPSIS plackup -r -R paths =head1 DESCRIPTION Plack::Loader::Restarter is a loader backend that implements C<-r> and C<-R> option for the L<plackup> script. It forks the server as a child process and the parent watches the directories for file updates, and whenever it receives the notification, kills the child server and restart. =head1 SEE ALSO L<Plack::Runner>, L<Catalyst::Restarter> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Loader/Shotgun.pm������������������������������������������������������������000644 �000765 �000024 �00000005467 12631015706 020612� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Loader::Shotgun; use strict; use parent qw(Plack::Loader); use Storable; use Try::Tiny; use Plack::Middleware::BufferedStreaming; die <<DIE if $^O eq 'MSWin32' && !$ENV{PLACK_SHOTGUN_MEMORY_LEAK}; Shotgun loader uses fork(2) system call to create a fresh Perl interpreter, that is known to not work properly in a fork-emulation layer on Windows and cause huge memory leaks. If you're aware of this and still want to run the loader, run it with the environment variable PLACK_SHOTGUN_MEMORY_LEAK on. DIE sub preload_app { my($self, $builder) = @_; $self->{builder} = sub { Plack::Middleware::BufferedStreaming->wrap($builder->()) }; } sub run { my($self, $server) = @_; my $app = sub { my $env = shift; pipe my $read, my $write; my $pid = fork; if ($pid) { # parent close $write; my $res = Storable::thaw(join '', <$read>); close $read; waitpid($pid, 0); return $res; } else { # child close $read; my $res; try { $env->{'psgi.streaming'} = 0; $res = $self->{builder}->()->($env); my @body; Plack::Util::foreach($res->[2], sub { push @body, $_[0] }); $res->[2] = \@body; } catch { $env->{'psgi.errors'}->print($_); $res = [ 500, [ "Content-Type", "text/plain" ], [ "Internal Server Error" ] ]; }; print {$write} Storable::freeze($res); close $write; exit; } }; $server->run($app); } 1; __END__ =head1 NAME Plack::Loader::Shotgun - forking implementation of plackup =head1 SYNOPSIS plackup -L Shotgun =head1 DESCRIPTION Shotgun loader delays the compilation and execution of your application until the runtime. When a new request comes in, this forks a new child, compiles your code and runs the application. This should be an ultimate alternative solution when reloading with L<Plack::Middleware::Refresh> doesn't work, or plackup's default C<-r> filesystem watcher causes problems. I can imagine this is useful for applications which expects their application is only evaluated once (like in-file templates) or on operating systems with broken fork implementation, etc. This is much like good old CGI's fork and run but you don't need a web server, and there's a benefit of preloading modules that are not likely to change. For instance if you develop a web application using Moose and DBIx::Class, plackup -MMoose -MDBIx::Class -L Shotgun yourapp.psgi would preload those modules and only re-evaluates your code in every request. =head1 AUTHOR Tatsuhiko Miyagawa with an inspiration from L<http://github.com/rtomayko/shotgun> =head1 SEE ALSO L<plackup> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/HTTPParser/PP.pm�������������������������������������������������������������000644 �000765 �000024 �00000004615 12631015706 020222� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::HTTPParser::PP; use strict; use warnings; use URI::Escape; sub parse_http_request { my($chunk, $env) = @_; $env ||= {}; # pre-header blank lines are allowed (RFC 2616 4.1) $chunk =~ s/^(\x0d?\x0a)+//; return -2 unless length $chunk; # double line break indicates end of header; parse it if ($chunk =~ /^(.*?\x0d?\x0a\x0d?\x0a)/s) { return _parse_header($chunk, length $1, $env); } return -2; # still waiting for unknown amount of header lines } sub _parse_header { my($chunk, $eoh, $env) = @_; my $header = substr($chunk, 0, $eoh,''); $chunk =~ s/^\x0d?\x0a\x0d?\x0a//; # parse into lines my @header = split /\x0d?\x0a/,$header; my $request = shift @header; # join folded lines my @out; for(@header) { if(/^[ \t]+/) { return -1 unless @out; $out[-1] .= $_; } else { push @out, $_; } } # parse request or response line my $obj; my ($major, $minor); my ($method,$uri,$http) = split / /,$request; return -1 unless $http and $http =~ /^HTTP\/(\d+)\.(\d+)$/i; ($major, $minor) = ($1, $2); $env->{REQUEST_METHOD} = $method; $env->{SERVER_PROTOCOL} = "HTTP/$major.$minor"; $env->{REQUEST_URI} = $uri; my($path, $query) = ( $uri =~ /^([^?]*)(?:\?(.*))?$/s ); for ($path, $query) { s/\#.*$// if defined && length } # dumb clients sending URI fragments $env->{PATH_INFO} = URI::Escape::uri_unescape($path); $env->{QUERY_STRING} = $query || ''; $env->{SCRIPT_NAME} = ''; # import headers my $token = qr/[^][\x00-\x1f\x7f()<>@,;:\\"\/?={} \t]+/; my $k; for my $header (@out) { if ( $header =~ s/^($token): ?// ) { $k = $1; $k =~ s/-/_/g; $k = uc $k; if ($k !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) { $k = "HTTP_$k"; } } elsif ( $header =~ /^\s+/) { # multiline header } else { return -1; } if (exists $env->{$k}) { $env->{$k} .= ", $header"; } else { $env->{$k} = $header; } } return $eoh; } 1; __END__ =head1 NAME Plack::HTTPParser::PP - Pure perl fallback of HTTP::Parser::XS =head1 DESCRIPTION Do not use this module directly. Use L<Plack::HTTPParser> instead. =head1 AUTHOR Tatsuhiko Miyagawa =cut �������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/Apache1.pm�����������������������������������������������������������000644 �000765 �000024 �00000007757 12631015706 020600� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler::Apache1; use strict; use Apache::Request; use Apache::Constants qw(:common :response); use Plack::Util; use Scalar::Util; my %apps; # psgi file to $app mapping sub new { bless {}, shift } sub preload { my $class = shift; for my $app (@_) { $class->load_app($app); } } sub load_app { my($class, $app) = @_; return $apps{$app} ||= do { # Trick Catalyst, CGI.pm, CGI::Cookie and others that check # for $ENV{MOD_PERL}. # # Note that we delete it instead of just localizing # $ENV{MOD_PERL} because some users may check if the key # exists, and we do it this way because "delete local" is new # in 5.12: # http://perldoc.perl.org/5.12.0/perldelta.html#delete-local local $ENV{MOD_PERL}; delete $ENV{MOD_PERL}; Plack::Util::load_psgi $app; }; } sub handler { my $class = __PACKAGE__; my $r = shift; my $psgi = $r->dir_config('psgi_app'); $class->call_app($r, $class->load_app($psgi)); } sub call_app { my ($class, $r, $app) = @_; $r->subprocess_env; # let Apache create %ENV for us :) my $env = { %ENV, 'psgi.version' => [ 1, 1 ], 'psgi.url_scheme' => ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http', 'psgi.input' => $r, 'psgi.errors' => *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, 'psgix.harakiri' => Plack::Util::TRUE, }; if (defined(my $HTTP_AUTHORIZATION = $r->headers_in->{Authorization})) { $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION; } my $vpath = $env->{SCRIPT_NAME} . ($env->{PATH_INFO} || ''); my $location = $r->location || "/"; $location =~ s{/$}{}; (my $path_info = $vpath) =~ s/^\Q$location\E//; $env->{SCRIPT_NAME} = $location; $env->{PATH_INFO} = $path_info; my $res = $app->($env); if (ref $res eq 'ARRAY') { _handle_response($r, $res); } elsif (ref $res eq 'CODE') { $res->(sub { _handle_response($r, $_[0]); }); } else { die "Bad response $res"; } if ($env->{'psgix.harakiri.commit'}) { $r->child_terminate; } return OK; } sub _handle_response { my ($r, $res) = @_; my ($status, $headers, $body) = @{ $res }; my $hdrs = ($status >= 200 && $status < 300) ? $r->headers_out : $r->err_headers_out; Plack::Util::header_iter($headers, sub { my($h, $v) = @_; if (lc $h eq 'content-type') { $r->content_type($v); } else { $hdrs->add($h => $v); } }); $r->status($status); $r->send_http_header; if (defined $body) { if (Plack::Util::is_real_fh($body)) { $r->send_fd($body); } else { Plack::Util::foreach($body, sub { $r->print(@_) }); } } else { return Plack::Util::inline_object write => sub { $r->print(@_) }, close => sub { }; } } 1; __END__ =head1 NAME Plack::Handler::Apache1 - Apache 1.3.x mod_perl handlers to run PSGI application =head1 SYNOPSIS <Location /> SetHandler perl-script PerlHandler Plack::Handler::Apache1 PerlSetVar psgi_app /path/to/app.psgi </Location> <Perl> use Plack::Handler::Apache1; Plack::Handler::Apache1->preload("/path/to/app.psgi"); </Perl> =head1 DESCRIPTION This is a mod_perl handler module to run any PSGI application with mod_perl on Apache 1.3.x. If you want to run PSGI applications I<behind> Apache instead of using mod_perl, see L<Plack::Handler::FCGI> to run with FastCGI, or use standalone HTTP servers such as L<Starman> or L<Starlet> proxied with mod_proxy. =head1 AUTHOR Aaron Trevena Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack> =cut �����������������Plack-1.0039/lib/Plack/Handler/Apache2/�������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 020223� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/Apache2.pm�����������������������������������������������������������000644 �000765 �000024 �00000024143 12631015706 020565� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler::Apache2; use strict; use warnings; use Apache2::RequestRec; use Apache2::RequestIO; use Apache2::RequestUtil; use Apache2::Response; use Apache2::Const -compile => qw(OK); use Apache2::Log; use APR::Table; use IO::Handle; use Plack::Util; use Scalar::Util; use URI; use URI::Escape; my %apps; # psgi file to $app mapping sub new { bless {}, shift } sub preload { my $class = shift; for my $app (@_) { $class->load_app($app); } } sub load_app { my($class, $app) = @_; return $apps{$app} ||= do { # Trick Catalyst, CGI.pm, CGI::Cookie and others that check # for $ENV{MOD_PERL}. # # Note that we delete it instead of just localizing # $ENV{MOD_PERL} because some users may check if the key # exists, and we do it this way because "delete local" is new # in 5.12: # http://perldoc.perl.org/5.12.0/perldelta.html#delete-local local $ENV{MOD_PERL}; delete $ENV{MOD_PERL}; Plack::Util::load_psgi $app; }; } sub call_app { my ($class, $r, $app) = @_; $r->subprocess_env; # let Apache create %ENV for us :) my $env = { %ENV, 'psgi.version' => [ 1, 1 ], 'psgi.url_scheme' => ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http', 'psgi.input' => $r, 'psgi.errors' => *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, 'psgix.harakiri' => Plack::Util::TRUE, 'psgix.cleanup' => Plack::Util::TRUE, 'psgix.cleanup.handlers' => [], }; if (defined(my $HTTP_AUTHORIZATION = $r->headers_in->{Authorization})) { $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION; } # If you supply more than one Content-Length header Apache will # happily concat the values with ", ", e.g. "72, 72". This # violates the PSGI spec so fix this up and just take the first # one. if (exists $env->{CONTENT_LENGTH} && $env->{CONTENT_LENGTH} =~ /,/) { no warnings qw(numeric); $env->{CONTENT_LENGTH} = int $env->{CONTENT_LENGTH}; } # Actually, we can not trust PATH_INFO from mod_perl because mod_perl squeezes multiple slashes into one slash. my $uri = URI->new("http://".$r->hostname.$r->unparsed_uri); $env->{PATH_INFO} = uri_unescape($uri->path); $class->fixup_path($r, $env); my $res = $app->($env); if (ref $res eq 'ARRAY') { _handle_response($r, $res); } elsif (ref $res eq 'CODE') { $res->(sub { _handle_response($r, $_[0]); }); } else { die "Bad response $res"; } if (@{ $env->{'psgix.cleanup.handlers'} }) { $r->push_handlers( PerlCleanupHandler => sub { for my $cleanup_handler (@{ $env->{'psgix.cleanup.handlers'} }) { $cleanup_handler->($env); } if ($env->{'psgix.harakiri.commit'}) { $r->child_terminate; } }, ); } else { if ($env->{'psgix.harakiri.commit'}) { $r->child_terminate; } } return Apache2::Const::OK; } sub handler { my $class = __PACKAGE__; my $r = shift; my $psgi = $r->dir_config('psgi_app'); $class->call_app($r, $class->load_app($psgi)); } # The method for PH::Apache2::Registry to override. sub fixup_path { my ($class, $r, $env) = @_; # $env->{PATH_INFO} is created from unparsed_uri so it is raw. my $path_info = $env->{PATH_INFO} || ''; # Get argument of <Location> or <LocationMatch> directive # This may be string or regexp and we can't know either. my $location = $r->location; # Let's *guess* if we're in a LocationMatch directive if ($location eq '/') { # <Location /> could be handled as a 'root' case where we make # everything PATH_INFO and empty SCRIPT_NAME as in the PSGI spec $env->{SCRIPT_NAME} = ''; } elsif ($path_info =~ s{^($location)/?}{/}) { $env->{SCRIPT_NAME} = $1 || ''; } else { # Apache's <Location> is matched but here is not. # This is something wrong. We can only respect original. $r->server->log_error( "Your request path is '$path_info' and it doesn't match your Location(Match) '$location'. " . "This should be due to the configuration error. See perldoc Plack::Handler::Apache2 for details." ); } $env->{PATH_INFO} = $path_info; } sub _handle_response { my ($r, $res) = @_; my ($status, $headers, $body) = @{ $res }; my $hdrs = ($status >= 200 && $status < 300) ? $r->headers_out : $r->err_headers_out; Plack::Util::header_iter($headers, sub { my($h, $v) = @_; if (lc $h eq 'content-type') { $r->content_type($v); } elsif (lc $h eq 'content-length') { $r->set_content_length($v); } else { $hdrs->add($h => $v); } }); $r->status($status); if (Scalar::Util::blessed($body) and $body->can('path') and my $path = $body->path) { $r->sendfile($path); } elsif (defined $body) { Plack::Util::foreach($body, sub { $r->print(@_) }); $r->rflush; } else { return Plack::Util::inline_object write => sub { $r->print(@_); $r->rflush }, close => sub { $r->rflush }; } return Apache2::Const::OK; } 1; __END__ =encoding utf-8 =head1 NAME Plack::Handler::Apache2 - Apache 2.0 mod_perl handler to run PSGI application =head1 SYNOPSIS # in your httpd.conf <Location /> SetHandler perl-script PerlResponseHandler Plack::Handler::Apache2 PerlSetVar psgi_app /path/to/app.psgi </Location> # Optionally preload your apps in startup PerlPostConfigRequire /etc/httpd/startup.pl See L</STARTUP FILE> for more details on writing a C<startup.pl>. =head1 DESCRIPTION This is a mod_perl handler module to run any PSGI application with mod_perl on Apache 2.x. If you want to run PSGI applications I<behind> Apache instead of using mod_perl, see L<Plack::Handler::FCGI> to run with FastCGI, or use standalone HTTP servers such as L<Starman> or L<Starlet> proxied with mod_proxy. =head1 CREATING CUSTOM HANDLER If you want to create a custom handler that loads or creates PSGI applications using other means than loading from C<.psgi> files, you can create your own handler class and use C<call_app> class method to run your application. package My::ModPerl::Handler; use Plack::Handler::Apache2; sub get_app { # magic! } sub handler { my $r = shift; my $app = get_app(); Plack::Handler::Apache2->call_app($r, $app); } =head1 STARTUP FILE Here is an example C<startup.pl> to preload PSGI applications: #!/usr/bin/env perl use strict; use warnings; use Apache2::ServerUtil (); BEGIN { return unless Apache2::ServerUtil::restart_count() > 1; require lib; lib->import('/path/to/my/perl/libs'); require Plack::Handler::Apache2; my @psgis = ('/path/to/app1.psgi', '/path/to/app2.psgi'); foreach my $psgi (@psgis) { Plack::Handler::Apache2->preload($psgi); } } 1; # file must return true! See L<http://perl.apache.org/docs/2.0/user/handlers/server.html#Startup_File> for general information on the C<startup.pl> file for preloading perl modules and your apps. Some things to keep in mind when writing this file: =over 4 =item * multiple init phases You have to check that L<Apache2::ServerUtil/restart_count> is C<< > 1 >>, otherwise your app will load twice and the env vars you set with L<PerlSetEnv|http://perl.apache.org/docs/2.0/user/config/config.html#C_PerlSetEnv_> will not be available when your app is loading the first time. Use the example above as a template. =item * C<@INC> The C<startup.pl> file is a good place to add entries to your C<@INC>. Use L<lib> to add entries, they can be in your app or C<.psgi> as well, but if your modules are in a L<local::lib> or some such, you will need to add the path for anything to load. Alternately, if you follow the example above, you can use: PerlSetEnv PERL5LIB /some/path or PerlSwitches -I/some/path in your C<httpd.conf>, which will also work. =item * loading errors Any exceptions thrown in your C<startup.pl> will stop Apache from starting at all. You probably don't want a stray syntax error to bring your whole server down in a shared or development environment, in which case it's a good idea to wrap the L</preload> call in an eval, using something like this: require Plack::Handler::Apache2; my @psgis = ('/path/to/app1.psgi', '/path/to/app2.psgi'); foreach my $psgi (@psgis) { eval { Plack::Handler::Apache2->preload($psgi); 1; } or do { my $error = $@ || 'Unknown Error'; # STDERR goes to the error_log print STDERR "Failed to load psgi '$psgi': $error\n"; }; } =item * dynamically loaded modules Some modules load their dependencies at runtime via e.g. L<Class::Load>. These modules will not get preloaded into your parent process by just including the app/module you are using. As an optimization, you can dump C<%INC> from a request to see if you are using any such modules and preload them in your C<startup.pl>. Another method is dumping the difference between the C<%INC> on process start and process exit. You can use something like this to accomplish this: my $start_inc = { %INC }; END { my @m; foreach my $m (keys %INC) { push @m, $m unless exists $start_inc->{$m}; } if (@m) { # STDERR goes to the error_log print STDERR "The following modules need to be preloaded:\n"; print STDERR "$_\n" for @m; } } =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 CONTRIBUTORS Paul Driver Ævar Arnfjörð Bjarmason Rafael Kitover =head1 SEE ALSO L<Plack> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/CGI.pm���������������������������������������������������������������000644 �000765 �000024 �00000013103 12631015706 017716� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler::CGI; use strict; use warnings; use IO::Handle; # copied from HTTP::Status my %StatusCode = ( 100 => 'Continue', 101 => 'Switching Protocols', 102 => 'Processing', # RFC 2518 (WebDAV) 200 => 'OK', 201 => 'Created', 202 => 'Accepted', 203 => 'Non-Authoritative Information', 204 => 'No Content', 205 => 'Reset Content', 206 => 'Partial Content', 207 => 'Multi-Status', # RFC 2518 (WebDAV) 300 => 'Multiple Choices', 301 => 'Moved Permanently', 302 => 'Found', 303 => 'See Other', 304 => 'Not Modified', 305 => 'Use Proxy', 307 => 'Temporary Redirect', 400 => 'Bad Request', 401 => 'Unauthorized', 402 => 'Payment Required', 403 => 'Forbidden', 404 => 'Not Found', 405 => 'Method Not Allowed', 406 => 'Not Acceptable', 407 => 'Proxy Authentication Required', 408 => 'Request Timeout', 409 => 'Conflict', 410 => 'Gone', 411 => 'Length Required', 412 => 'Precondition Failed', 413 => 'Request Entity Too Large', 414 => 'Request-URI Too Large', 415 => 'Unsupported Media Type', 416 => 'Request Range Not Satisfiable', 417 => 'Expectation Failed', 422 => 'Unprocessable Entity', # RFC 2518 (WebDAV) 423 => 'Locked', # RFC 2518 (WebDAV) 424 => 'Failed Dependency', # RFC 2518 (WebDAV) 425 => 'No code', # WebDAV Advanced Collections 426 => 'Upgrade Required', # RFC 2817 449 => 'Retry with', # unofficial Microsoft 500 => 'Internal Server Error', 501 => 'Not Implemented', 502 => 'Bad Gateway', 503 => 'Service Unavailable', 504 => 'Gateway Timeout', 505 => 'HTTP Version Not Supported', 506 => 'Variant Also Negotiates', # RFC 2295 507 => 'Insufficient Storage', # RFC 2518 (WebDAV) 509 => 'Bandwidth Limit Exceeded', # unofficial 510 => 'Not Extended', # RFC 2774 ); sub new { bless {}, shift } sub run { my ($self, $app) = @_; my $env = $self->setup_env(); my $res = $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 setup_env { my ( $self, $override_env ) = @_; $override_env ||= {}; binmode STDIN; binmode STDERR; my $env = { %ENV, 'psgi.version' => [ 1, 1 ], 'psgi.url_scheme' => ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http', 'psgi.input' => *STDIN, 'psgi.errors' => *STDERR, 'psgi.multithread' => 0, 'psgi.multiprocess' => 1, 'psgi.run_once' => 1, 'psgi.streaming' => 1, 'psgi.nonblocking' => 1, %{ $override_env }, }; delete $env->{HTTP_CONTENT_TYPE}; delete $env->{HTTP_CONTENT_LENGTH}; $env->{'HTTP_COOKIE'} ||= $ENV{COOKIE}; # O'Reilly server bug if (!exists $env->{PATH_INFO}) { $env->{PATH_INFO} = ''; } if ($env->{SCRIPT_NAME} eq '/') { $env->{SCRIPT_NAME} = ''; $env->{PATH_INFO} = '/' . $env->{PATH_INFO}; } return $env; } sub _handle_response { my ($self, $res) = @_; *STDOUT->autoflush(1); binmode STDOUT; my $hdrs; my $message = $StatusCode{$res->[0]}; $hdrs = "Status: $res->[0] $message\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 $body = $res->[2]; my $cb = sub { print STDOUT $_[0] }; # inline Plack::Util::foreach here if (ref $body eq 'ARRAY') { for my $line (@$body) { $cb->($line) if length $line; } } elsif (defined $body) { local $/ = \65536 unless ref $/; while (defined(my $line = $body->getline)) { $cb->($line) if length $line; } $body->close; } else { return Plack::Handler::CGI::Writer->new; } } package Plack::Handler::CGI::Writer; sub new { bless \do { my $x }, $_[0] } sub write { print STDOUT $_[1] } sub close { } package Plack::Handler::CGI; 1; __END__ =head1 NAME Plack::Handler::CGI - CGI handler for Plack =head1 SYNOPSIS Want to run PSGI application as a CGI script? Rename .psgi to .cgi and change the shebang line like: #!/usr/bin/env plackup # rest of the file can be the same as other .psgi file You can alternatively create a .cgi file that contains something like: #!/usr/bin/perl use Plack::Loader; my $app = Plack::Util::load_psgi("/path/to/app.psgi"); Plack::Loader->auto->run($app); This will auto-recognize the CGI environment variable to load this class. If you really want to explicitly load the CGI handler, you can. For instance you might do this when you want to embed a PSGI application server built into CGI-compatible perl-based web server: use Plack::Handler::CGI; Plack::Handler::CGI->new->run($app); =head1 DESCRIPTION This is a handler module to run any PSGI application as a CGI script. =head1 UTILITY METHODS =head2 setup_env() my $env = Plack::Handler::CGI->setup_env(); my $env = Plack::Handler::CGI->setup_env(\%override_env); Sets up the PSGI environment hash for a CGI request from C<< %ENV >>> and returns it. You can provide a hashref of key/value pairs to override the defaults if you would like. =head1 SEE ALSO L<Plack> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/FCGI.pm��������������������������������������������������������������000644 �000765 �000024 �00000030505 12631015706 020031� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler::FCGI; use strict; use warnings; use constant RUNNING_IN_HELL => $^O eq 'MSWin32'; use Scalar::Util qw(blessed); use Plack::Util; use FCGI; use HTTP::Status qw(status_message); use URI; use URI::Escape; sub new { my $class = shift; my $self = bless {@_}, $class; $self->{leave_umask} ||= 0; $self->{keep_stderr} ||= 0; $self->{nointr} ||= 0; $self->{daemonize} ||= $self->{detach}; # compatibility $self->{nproc} ||= 1 unless blessed $self->{manager}; $self->{pid} ||= $self->{pidfile}; # compatibility $self->{listen} ||= [ ":$self->{port}" ] if $self->{port}; # compatibility $self->{backlog} ||= 100; $self->{manager} = 'FCGI::ProcManager' unless exists $self->{manager}; $self; } sub run { my ($self, $app) = @_; my $running_on_server_starter = exists $ENV{SERVER_STARTER_PORT}; my $sock = 0; if (-S STDIN) { # running from web server. Do nothing # Note it should come before listen check because of plackup's default } elsif ($running_on_server_starter) { # Runing under Server::Starter require Server::Starter; my %socks = %{Server::Starter::server_ports()}; if (scalar(keys(%socks)) > 1) { die "More than one socket are specified by Server::Starter"; } $sock = (values %socks)[0]; } elsif ($self->{listen}) { my $old_umask = umask; unless ($self->{leave_umask}) { umask(0); } $sock = FCGI::OpenSocket( $self->{listen}->[0], $self->{backlog} ) or die "failed to open FastCGI socket: $!"; unless ($self->{leave_umask}) { umask($old_umask); } } elsif (!RUNNING_IN_HELL) { die "STDIN is not a socket: specify a listen location"; } @{$self}{qw(stdin stdout stderr)} = (IO::Handle->new, IO::Handle->new, IO::Handle->new); my %env; my $request = FCGI::Request( $self->{stdin}, $self->{stdout}, $self->{stderr}, \%env, $sock, ($self->{nointr} ? 0 : &FCGI::FAIL_ACCEPT_ON_INTR), ); my $proc_manager; if ($self->{listen} or $running_on_server_starter) { $self->daemon_fork if $self->{daemonize}; if ($self->{manager}) { if (blessed $self->{manager}) { for (qw(nproc pid proc_title)) { die "Don't use '$_' when passing in a 'manager' object" if $self->{$_}; } $proc_manager = $self->{manager}; } else { Plack::Util::load_class($self->{manager}); $proc_manager = $self->{manager}->new({ n_processes => $self->{nproc}, pid_fname => $self->{pid}, (exists $self->{proc_title} ? (pm_title => $self->{proc_title}) : ()), }); } # detach *before* the ProcManager inits $self->daemon_detach if $self->{daemonize}; } elsif ($self->{daemonize}) { $self->daemon_detach; } } elsif (blessed $self->{manager}) { $proc_manager = $self->{manager}; } $proc_manager && $proc_manager->pm_manage; while ($request->Accept >= 0) { $proc_manager && $proc_manager->pm_pre_dispatch; my $env = { %env, 'psgi.version' => [1,1], 'psgi.url_scheme' => ($env{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http', 'psgi.input' => $self->{stdin}, 'psgi.errors' => ($self->{keep_stderr} ? \*STDERR : $self->{stderr}), 'psgi.multithread' => Plack::Util::FALSE, 'psgi.multiprocess' => defined $proc_manager, 'psgi.run_once' => Plack::Util::FALSE, 'psgi.streaming' => Plack::Util::TRUE, 'psgi.nonblocking' => Plack::Util::FALSE, 'psgix.harakiri' => defined $proc_manager, }; delete $env->{HTTP_CONTENT_TYPE}; delete $env->{HTTP_CONTENT_LENGTH}; # lighttpd munges multiple slashes in PATH_INFO into one. Try recovering it my $uri = URI->new("http://localhost" . $env->{REQUEST_URI}); $env->{PATH_INFO} = uri_unescape($uri->path); $env->{PATH_INFO} =~ s/^\Q$env->{SCRIPT_NAME}\E//; # root access for mod_fastcgi if (!exists $env->{PATH_INFO}) { $env->{PATH_INFO} = ''; } # typical fastcgi_param from nginx might get empty values for my $key (qw(CONTENT_TYPE CONTENT_LENGTH)) { no warnings; delete $env->{$key} if exists $env->{$key} && $env->{$key} eq ''; } if (defined(my $HTTP_AUTHORIZATION = $env->{Authorization})) { $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION; } my $res = Plack::Util::run_app $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"; } # give pm_post_dispatch the chance to do things after the client thinks # the request is done $request->Finish; $proc_manager && $proc_manager->pm_post_dispatch(); if ($proc_manager && $env->{'psgix.harakiri.commit'}) { $proc_manager->pm_exit("safe exit with harakiri"); } } } sub _handle_response { my ($self, $res) = @_; $self->{stdout}->autoflush(1); binmode $self->{stdout}; my $hdrs; my $message = status_message($res->[0]); $hdrs = "Status: $res->[0] $message\015\012"; my $headers = $res->[1]; while (my ($k, $v) = splice @$headers, 0, 2) { $hdrs .= "$k: $v\015\012"; } $hdrs .= "\015\012"; print { $self->{stdout} } $hdrs; my $cb = sub { print { $self->{stdout} } $_[0] }; my $body = $res->[2]; if (defined $body) { Plack::Util::foreach($body, $cb); } else { return Plack::Util::inline_object write => $cb, close => sub { }; } } sub daemon_fork { require POSIX; fork && exit; } sub daemon_detach { my $self = shift; print "FastCGI daemon started (pid $$)\n"; open STDIN, "+</dev/null" or die $!; ## no critic open STDOUT, ">&STDIN" or die $!; open STDERR, ">&STDIN" or die $!; POSIX::setsid(); } 1; __END__ =head1 NAME Plack::Handler::FCGI - FastCGI handler for Plack =head1 SYNOPSIS # Run as a standalone daemon plackup -s FCGI --listen /tmp/fcgi.sock --daemonize --nproc 10 # Run from your web server like mod_fastcgi #!/usr/bin/env plackup -s FCGI my $app = sub { ... }; # Roll your own my $server = Plack::Handler::FCGI->new( nproc => $num_proc, listen => [ $port_or_socket ], detach => 1, ); $server->run($app); =head1 DESCRIPTION This is a handler module to run any PSGI application as a standalone FastCGI daemon or a .fcgi script. =head2 OPTIONS =over 4 =item listen listen => [ '/path/to/socket' ] listen => [ ':8080' ] Listen on a socket path, hostname:port, or :port. =item port listen via TCP on port on all interfaces (Same as C<< listen => ":$port" >>) =item leave-umask Set to 1 to disable setting umask to 0 for socket open =item nointr Do not allow the listener to be interrupted by Ctrl+C =item nproc Specify a number of processes for FCGI::ProcManager =item pid Specify a filename for the pid file =item manager Specify either a FCGI::ProcManager subclass, or an actual FCGI::ProcManager-compatible object. If you do not want a FCGI::ProcManager but instead run in a single process, set this to undef. use FCGI::ProcManager::Dynamic; Plack::Handler::FCGI->new( manager => FCGI::ProcManager::Dynamic->new(...), ); =item daemonize Daemonize the process. =item proc-title Specify process title =item keep-stderr Send psgi.errors to STDERR instead of to the FCGI error stream. =item backlog Maximum length of the queue of pending connections =back =head2 WEB SERVER CONFIGURATIONS In all cases, you will want to install L<FCGI> and L<FCGI::ProcManager>. You may find it most convenient to simply install L<Task::Plack> which includes both of these. =head3 nginx This is an example nginx configuration to run your FCGI daemon on a Unix domain socket and run it at the server's root URL (/). http { server { listen 3001; location / { set $script ""; set $path_info $uri; fastcgi_pass unix:/tmp/fastcgi.sock; fastcgi_param SCRIPT_NAME $script; fastcgi_param PATH_INFO $path_info; fastcgi_param QUERY_STRING $query_string; fastcgi_param REQUEST_METHOD $request_method; fastcgi_param CONTENT_TYPE $content_type; fastcgi_param CONTENT_LENGTH $content_length; fastcgi_param REQUEST_URI $request_uri; fastcgi_param SERVER_PROTOCOL $server_protocol; fastcgi_param REMOTE_ADDR $remote_addr; fastcgi_param REMOTE_PORT $remote_port; fastcgi_param SERVER_ADDR $server_addr; fastcgi_param SERVER_PORT $server_port; fastcgi_param SERVER_NAME $server_name; } } } If you want to host your application in a non-root path, then you should mangle this configuration to set the path to C<SCRIPT_NAME> and the rest of the path in C<PATH_INFO>. See L<http://wiki.nginx.org/NginxFcgiExample> for more details. =head3 Apache mod_fastcgi After installing C<mod_fastcgi>, you should add the C<FastCgiExternalServer> directive to your Apache config: FastCgiExternalServer /tmp/myapp.fcgi -socket /tmp/fcgi.sock ## Then set up the location that you want to be handled by fastcgi: # EITHER from a given path Alias /myapp/ /tmp/myapp.fcgi/ # OR at the root Alias / /tmp/myapp.fcgi/ Now you can use plackup to listen to the socket that you've just configured in Apache. $ plackup -s FCGI --listen /tmp/myapp.sock psgi/myapp.psgi The above describes the "standalone" method, which is usually appropriate. There are other methods, described in more detail at L<Catalyst::Engine::FastCGI/Standalone_server_mode> (with regards to Catalyst, but which may be set up similarly for Plack). See also L<http://www.fastcgi.com/mod_fastcgi/docs/mod_fastcgi.html#FastCgiExternalServer> for more details. =head3 lighttpd To host the app in the root path, you're recommended to use lighttpd 1.4.23 or newer with C<fix-root-scriptname> flag like below. fastcgi.server = ( "/" => (( "socket" => "/tmp/fcgi.sock", "check-local" => "disable", "fix-root-scriptname" => "enable", )) If you use lighttpd older than 1.4.22 where you don't have C<fix-root-scriptname>, mounting apps under the root causes wrong C<SCRIPT_NAME> and C<PATH_INFO> set. Also, mounting under the empty root (C<"">) or a path that has a trailing slash would still cause weird values set even with C<fix-root-scriptname>. In such cases you can use L<Plack::Middleware::LighttpdScriptNameFix> to fix it. To mount in the non-root path over TCP: fastcgi.server = ( "/foo" => (( "host" = "127.0.0.1", "port" = "5000", "check-local" => "disable", )) It's recommended that your mount path does B<NOT> have the trailing slash. If you I<really> need to have one, you should consider using L<Plack::Middleware::LighttpdScriptNameFix> to fix the wrong B<PATH_INFO> values set by lighttpd. =cut =head2 Authorization Most fastcgi configuration does not pass C<Authorization> headers to C<HTTP_AUTHORIZATION> environment variable by default for security reasons. Authentication middleware such as L<Plack::Middleware::Auth::Basic> or L<Catalyst::Authentication::Credential::HTTP> requires the variable to be set up. Plack::Handler::FCGI supports extracting the C<Authorization> environment variable when it is configured that way. Apache2 with mod_fastcgi: --pass-header Authorization mod_fcgid: FcgiPassHeader Authorization =head2 Server::Starter This plack handler supports L<Server::Starter> as a superdaemon. Simply launch plackup from start_server with a path option. The listen option is ignored when launched from Server::Starter. start_server --path=/tmp/socket -- plackup -s FCGI app.psgi =head1 SEE ALSO L<Plack> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/HTTP/����������������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 017537� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/Standalone.pm��������������������������������������������������������000644 �000765 �000024 �00000001045 12631015706 021406� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler::Standalone; use strict; use warnings; use parent qw( Plack::Handler::HTTP::Server::PSGI ); 1; __END__ =head1 NAME Plack::Handler::Standalone - adapter for HTTP::Server::PSGI =head1 SYNOPSIS % plackup -s Standalone \ --host 127.0.0.1 --port 9091 --timeout 120 =head1 DESCRIPTION Plack::Handler::Standalone is an adapter for default Plack server implementation L<HTTP::Server::PSGI>. This is just an alias for L<Plack::Handler::HTTP::Server::PSGI>. =head1 SEE ALSO L<Plack::Handler::HTTP::Server::PSGI> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/HTTP/Server/���������������������������������������������������������000755 �000765 �000024 �00000000000 12631015706 021005� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/HTTP/Server/PSGI.pm��������������������������������������������������000644 �000765 �000024 �00000002221 12631015706 022102� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler::HTTP::Server::PSGI; use strict; # for temporary backward compat use parent qw( HTTP::Server::PSGI ); sub new { my($class, %args) = @_; bless { %args }, $class; } sub run { my($self, $app) = @_; $self->_server->run($app); } sub _server { my $self = shift; HTTP::Server::PSGI->new(%$self); } 1; __END__ =head1 NAME Plack::Handler::HTTP::Server::PSGI - adapter for HTTP::Server::PSGI =head1 SYNOPSIS % plackup -s HTTP::Server::PSGI \ --host 127.0.0.1 --port 9091 --timeout 120 =head1 BACKWARD COMPATIBLITY Since Plack 0.99_22 this handler doesn't support preforking configuration i.e. C<--max-workers>. Use L<Starman> or L<Starlet> if you need preforking PSGI web server. =head1 CONFIGURATIONS =over 4 =item host Host the server binds to. Defaults to all interfaces. =item port Port number the server listens on. Defaults to 8080. =item timeout Number of seconds a request times out. Defaults to 300. =item max-reqs-per-child Number of requests per worker to process. Defaults to 100. =back =head1 AUTHOR Kazuho Oku Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack> L<HTTP::Server::PSGI> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/Handler/Apache2/Registry.pm��������������������������������������������������000644 �000765 �000024 �00000002214 12631015706 022370� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::Handler::Apache2::Registry; use strict; use warnings; use Try::Tiny; use Apache2::Const; use Apache2::Log; use parent qw/Plack::Handler::Apache2/; sub handler { my $class = __PACKAGE__; my ($r) = @_; return try { my $app = $class->load_app( $r->filename ); $class->call_app( $r, $app ); }catch{ if(/no such file/i){ $r->log_error( $_ ); return Apache2::Const::NOT_FOUND; }else{ $r->log_error( $_ ); return Apache2::Const::SERVER_ERROR; } }; } # Overriding sub fixup_path { my ($class, $r, $env) = @_; $env->{PATH_INFO} =~ s{^$env->{SCRIPT_NAME}}{}; } 1; __END__ =head1 NAME Plack::Handler::Apache2::Registry - Runs .psgi files. =head1 SYNOPSIS PerlModule Plack::Handler::Apache2::Registry; <Location /psgi-bin> SetHandler modperl PerlHandler Plack::Handler::Apache2::Registry </Location> =head1 DESCRIPTION This is a handler module to run any *.psgi files with mod_perl2, just like ModPerl::Registry. =head1 AUTHOR Masahiro Honma E<lt>hiratara@cpan.orgE<gt> =head1 SEE ALSO L<Plack::Handler::Apache2> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/App/Cascade.pm���������������������������������������������������������������000644 �000765 �000024 �00000005256 12631015706 020014� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::App::Cascade; use strict; use base qw(Plack::Component); use Plack::Util; use Plack::Util::Accessor qw(apps catch codes); sub add { my $self = shift; $self->apps([]) unless $self->apps; push @{$self->apps}, @_; } sub prepare_app { my $self = shift; my %codes = map { $_ => 1 } @{ $self->catch || [ 404 ] }; $self->codes(\%codes); } sub call { my($self, $env) = @_; return sub { my $respond = shift; my $done; my $respond_wrapper = sub { my $res = shift; if ($self->codes->{$res->[0]}) { # suppress output by giving the app an # output spool which drops everything on the floor return Plack::Util::inline_object write => sub { }, close => sub { }; } else { $done = 1; return $respond->($res); } }; my @try = @{$self->apps || []}; my $tries_left = 0 + @try; if (not $tries_left) { return $respond->([ 404, [ 'Content-Type' => 'text/html' ], [ '404 Not Found' ] ]) } for my $app (@try) { my $res = $app->($env); if ($tries_left-- == 1) { $respond_wrapper = sub { $respond->(shift) }; } if (ref $res eq 'CODE') { $res->($respond_wrapper); } else { $respond_wrapper->($res); } return if $done; } }; } 1; __END__ =head1 NAME Plack::App::Cascade - Cascadable compound application =head1 SYNOPSIS use Plack::App::Cascade; use Plack::App::URLMap; use Plack::App::File; # Serve static files from multiple search paths my $cascade = Plack::App::Cascade->new; $cascade->add( Plack::App::File->new(root => "/www/example.com/foo")->to_app ); $cascade->add( Plack::App::File->new(root => "/www/example.com/bar")->to_app ); my $app = Plack::App::URLMap->new; $app->map("/static", $cascade); $app->to_app; =head1 DESCRIPTION Plack::App::Cascade is a Plack middleware component that compounds several apps and tries them to return the first response that is not 404. =head1 METHODS =over 4 =item new $app = Plack::App::Cascade->new(apps => [ $app1, $app2 ]); Creates a new Cascade application. =item add $app->add($app1); $app->add($app2, $app3); Appends a new application to the list of apps to try. You can pass the multiple apps to the one C<add> call. =item catch $app->catch([ 403, 404 ]); Sets which error codes to catch and process onwards. Defaults to C<404>. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::App::URLMap> Rack::Cascade =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/App/CGIBin.pm����������������������������������������������������������������000644 �000765 �000024 �00000006332 12631015706 017520� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::App::CGIBin; use strict; use warnings; use parent qw/Plack::App::File/; use Plack::Util::Accessor qw( exec_cb ); use Plack::App::WrapCGI; sub allow_path_info { 1 } my %exec_cache; sub would_exec { my($self, $file) = @_; return $exec_cache{$file} if exists $exec_cache{$file}; my $exec_cb = $self->exec_cb || sub { $self->exec_cb_default(@_) }; return $exec_cache{$file} = $exec_cb->($file); } sub exec_cb_default { my($self, $file) = @_; if ($file =~ /\.pl$/i) { return 0; } elsif ($self->shebang_for($file) =~ /^\#\!.*perl/) { return 0; } else { return 1; } } sub shebang_for { my($self, $file) = @_; open my $fh, "<", $file or return ''; my $line = <$fh>; return $line; } sub serve_path { my($self, $env, $file) = @_; local @{$env}{qw(SCRIPT_NAME PATH_INFO)} = @{$env}{qw( plack.file.SCRIPT_NAME plack.file.PATH_INFO )}; my $app = $self->{_compiled}->{$file} ||= Plack::App::WrapCGI->new( script => $file, execute => $self->would_exec($file), )->to_app; $app->($env); } 1; __END__ =head1 NAME Plack::App::CGIBin - cgi-bin replacement for Plack servers =head1 SYNOPSIS use Plack::App::CGIBin; use Plack::Builder; my $app = Plack::App::CGIBin->new(root => "/path/to/cgi-bin")->to_app; builder { mount "/cgi-bin" => $app; }; # Or from the command line plackup -MPlack::App::CGIBin -e 'Plack::App::CGIBin->new(root => "/path/to/cgi-bin")->to_app' =head1 DESCRIPTION Plack::App::CGIBin allows you to load CGI scripts from a directory and convert them into a PSGI application. This would give you the extreme easiness when you have bunch of old CGI scripts that is loaded using I<cgi-bin> of Apache web server. =head1 HOW IT WORKS This application checks if a given file path is a perl script and if so, uses L<CGI::Compile> to compile a CGI script into a sub (like L<ModPerl::Registry>) and then run it as a persistent application using L<CGI::Emulate::PSGI>. If the given file is not a perl script, it executes the script just like a normal CGI script with fork & exec. This is like a normal web server mode and no performance benefit is achieved. The default mechanism to determine if a given file is a Perl script is as follows: =over 4 =item * Check if the filename ends with C<.pl>. If yes, it is a Perl script. =item * Open the file and see if the shebang (first line of the file) contains the word C<perl> (like C<#!/usr/bin/perl>). If yes, it is a Perl script. =back You can customize this behavior by passing C<exec_cb> callback, which takes a file path to its first argument. For example, if your perl-based CGI script uses lots of global variables and such and are not ready to run on a persistent environment, you can do: my $app = Plack::App::CGIBin->new( root => "/path/to/cgi-bin", exec_cb => sub { 1 }, )->to_app; to always force the execute option for any files. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L<Plack::App::File> L<CGI::Emulate::PSGI> L<CGI::Compile> L<Plack::App::WrapCGI> See also L<Plack::App::WrapCGI> if you compile one CGI script into a PSGI application without serving CGI scripts from a directory, to remove overhead of filesystem lookups, etc. =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plack-1.0039/lib/Plack/App/Directory.pm�������������������������������������������������������������000644 �000765 �000024 �00000006265 12631015706 020436� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plack::App::Directory; use parent qw(Plack::App::File); use strict; use warnings; use Plack::Util; use HTTP::Date; use Plack::MIME; use DirHandle; use URI::Escape; use Plack::Request; # Stolen from rack/directory.rb my $dir_file = "<tr><td class='name'><a href='%s'>%s</a></td><td class='size'>%s</td><td class='type'>%s</td><td class='mtime'>%s</td></tr>"; my $dir_page = <<PAGE; <html><head> <title>%s

%s


%s
Name Size Type Last Modified

PAGE sub should_handle { my($self, $file) = @_; return -d $file || -f $file; } sub return_dir_redirect { my ($self, $env) = @_; my $uri = Plack::Request->new($env)->uri; return [ 301, [ 'Location' => $uri . '/', 'Content-Type' => 'text/plain', 'Content-Length' => 8, ], [ 'Redirect' ], ]; } sub serve_path { my($self, $env, $dir, $fullpath) = @_; if (-f $dir) { return $self->SUPER::serve_path($env, $dir, $fullpath); } my $dir_url = $env->{SCRIPT_NAME} . $env->{PATH_INFO}; if ($dir_url !~ m{/$}) { return $self->return_dir_redirect($env); } my @files = ([ "../", "Parent Directory", '', '', '' ]); my $dh = DirHandle->new($dir); my @children; while (defined(my $ent = $dh->read)) { next if $ent eq '.' or $ent eq '..'; push @children, $ent; } for my $basename (sort { $a cmp $b } @children) { my $file = "$dir/$basename"; my $url = $dir_url . $basename; my $is_dir = -d $file; my @stat = stat _; $url = join '/', map {uri_escape($_)} split m{/}, $url; if ($is_dir) { $basename .= "/"; $url .= "/"; } my $mime_type = $is_dir ? 'directory' : ( Plack::MIME->mime_type($file) || 'text/plain' ); push @files, [ $url, $basename, $stat[7], $mime_type, HTTP::Date::time2str($stat[9]) ]; } my $path = Plack::Util::encode_html("Index of $env->{PATH_INFO}"); my $files = join "\n", map { my $f = $_; sprintf $dir_file, map Plack::Util::encode_html($_), @$f; } @files; my $page = sprintf $dir_page, $path, $path, $files; return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ]; } 1; __END__ =head1 NAME Plack::App::Directory - Serve static files from document root with directory index =head1 SYNOPSIS # app.psgi use Plack::App::Directory; my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" })->to_app; =head1 DESCRIPTION This is a static file server PSGI application with directory index a la Apache's mod_autoindex. =head1 CONFIGURATION =over 4 =item root Document root directory. Defaults to the current directory. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L =cut Plack-1.0039/lib/Plack/App/File.pm000644 000765 000024 00000010711 12631015706 017340 0ustar00miyagawastaff000000 000000 package Plack::App::File; use strict; use warnings; use parent qw/Plack::Component/; use File::Spec::Unix; use Cwd (); use Plack::Util; use Plack::MIME; use HTTP::Date; use Plack::Util::Accessor qw( root file content_type encoding ); sub should_handle { my($self, $file) = @_; return -f $file; } sub call { my $self = shift; my $env = shift; my($file, $path_info) = $self->file || $self->locate_file($env); return $file if ref $file eq 'ARRAY'; if ($path_info) { $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO}; $env->{'plack.file.SCRIPT_NAME'} =~ s/\Q$path_info\E$//; $env->{'plack.file.PATH_INFO'} = $path_info; } else { $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO}; $env->{'plack.file.PATH_INFO'} = ''; } return $self->serve_path($env, $file); } sub locate_file { my($self, $env) = @_; my $path = $env->{PATH_INFO} || ''; if ($path =~ /\0/) { return $self->return_400; } my $docroot = $self->root || "."; my @path = split /[\\\/]/, $path, -1; # -1 *MUST* be here to avoid security issues! if (@path) { shift @path if $path[0] eq ''; } else { @path = ('.'); } if (grep /^\.{2,}$/, @path) { return $self->return_403; } my($file, @path_info); while (@path) { my $try = File::Spec::Unix->catfile($docroot, @path); if ($self->should_handle($try)) { $file = $try; last; } elsif (!$self->allow_path_info) { last; } unshift @path_info, pop @path; } if (!$file) { return $self->return_404; } if (!-r $file) { return $self->return_403; } return $file, join("/", "", @path_info); } sub allow_path_info { 0 } sub serve_path { my($self, $env, $file) = @_; my $content_type = $self->content_type || Plack::MIME->mime_type($file) || 'text/plain'; if ("CODE" eq ref $content_type) { $content_type = $content_type->($file); } if ($content_type =~ m!^text/!) { $content_type .= "; charset=" . ($self->encoding || "utf-8"); } open my $fh, "<:raw", $file or return $self->return_403; my @stat = stat $file; Plack::Util::set_io_path($fh, Cwd::realpath($file)); return [ 200, [ 'Content-Type' => $content_type, 'Content-Length' => $stat[7], 'Last-Modified' => HTTP::Date::time2str( $stat[9] ) ], $fh, ]; } sub return_403 { my $self = shift; return [403, ['Content-Type' => 'text/plain', 'Content-Length' => 9], ['forbidden']]; } sub return_400 { my $self = shift; return [400, ['Content-Type' => 'text/plain', 'Content-Length' => 11], ['Bad Request']]; } # Hint: subclasses can override this to return undef to pass through 404 sub return_404 { my $self = shift; return [404, ['Content-Type' => 'text/plain', 'Content-Length' => 9], ['not found']]; } 1; __END__ =head1 NAME Plack::App::File - Serve static files from root directory =head1 SYNOPSIS use Plack::App::File; my $app = Plack::App::File->new(root => "/path/to/htdocs")->to_app; # Or map the path to a specific file use Plack::Builder; builder { mount "/favicon.ico" => Plack::App::File->new(file => '/path/to/favicon.ico')->to_app; }; =head1 DESCRIPTION This is a static file server PSGI application, and internally used by L. This application serves file from document root if the path matches with the local file. Use L if you want to list files in the directory as well. =head1 CONFIGURATION =over 4 =item root Document root directory. Defaults to C<.> (current directory) =item file The file path to create responses from. Optional. If it's set the application would B create a response out of the file and there will be no security check etc. (hence fast). If it's not set, the application uses C to find the matching file. =item encoding Set the file encoding for text files. Defaults to C. =item content_type Set the file content type. If not set L will try to detect it based on the file extension or fall back to C. Can be set to a callback which should work on $_[0] to check full path file name. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L L =cut Plack-1.0039/lib/Plack/App/PSGIBin.pm000644 000765 000024 00000002661 12631015706 017661 0ustar00miyagawastaff000000 000000 package Plack::App::PSGIBin; use strict; use warnings; use parent qw/Plack::App::File/; use Plack::Util; sub allow_path_info { 1 } sub serve_path { my($self, $env, $file) = @_; local @{$env}{qw(SCRIPT_NAME PATH_INFO)} = @{$env}{qw( plack.file.SCRIPT_NAME plack.file.PATH_INFO )}; my $app = $self->{_compiled}->{$file} ||= Plack::Util::load_psgi($file); $app->($env); } 1; __END__ =head1 NAME Plack::App::PSGIBin - Run .psgi files from a directory =head1 SYNOPSIS use Plack::App::PSGIBin; use Plack::Builder; my $app = Plack::App::PSGIBin->new(root => "/path/to/psgi/scripts")->to_app; builder { mount "/psgi" => $app; }; # Or from the command line plackup -MPlack::App::PSGIBin -e 'Plack::App::PSGIBin->new(root => "/path/psgi/scripts")->to_app' =head1 DESCRIPTION This application loads I<.psgi> files (or actually whichever filename extensions) from the root directory and run it as a PSGI application. Suppose you have a directory containing C and C, map this application to C with L and you can access them via the URL: http://example.com/app/foo.psgi http://example.com/app/bar.psgi to load them. You can rename the file to the one without C<.psgi> extension to make the URL look nicer, or use the URL rewriting tools like L to do the same thing. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L Plack-1.0039/lib/Plack/App/URLMap.pm000644 000765 000024 00000013012 12631015706 017556 0ustar00miyagawastaff000000 000000 package Plack::App::URLMap; use strict; use warnings; use parent qw(Plack::Component); use constant DEBUG => $ENV{PLACK_URLMAP_DEBUG}; use Carp (); sub mount { shift->map(@_) } sub map { my $self = shift; my($location, $app) = @_; my $host; if ($location =~ m!^https?://(.*?)(/.*)!) { $host = $1; $location = $2; } if ($location !~ m!^/!) { Carp::croak("Paths need to start with /"); } $location =~ s!/$!!; push @{$self->{_mapping}}, [ $host, $location, qr/^\Q$location\E/, $app ]; } sub prepare_app { my $self = shift; # sort by path length $self->{_sorted_mapping} = [ map { [ @{$_}[2..5] ] } sort { $b->[0] <=> $a->[0] || $b->[1] <=> $a->[1] } map { [ ($_->[0] ? length $_->[0] : 0), length($_->[1]), @$_ ] } @{$self->{_mapping}}, ]; } sub call { my ($self, $env) = @_; my $path_info = $env->{PATH_INFO}; my $script_name = $env->{SCRIPT_NAME}; my($http_host, $server_name) = @{$env}{qw( HTTP_HOST SERVER_NAME )}; if ($http_host and my $port = $env->{SERVER_PORT}) { $http_host =~ s/:$port$//; } for my $map (@{ $self->{_sorted_mapping} }) { my($host, $location, $location_re, $app) = @$map; my $path = $path_info; # copy no warnings 'uninitialized'; DEBUG && warn "Matching request (Host=$http_host Path=$path) and the map (Host=$host Path=$location)\n"; next unless not defined $host or $http_host eq $host or $server_name eq $host; next unless $location eq '' or $path =~ s!$location_re!!; next unless $path eq '' or $path =~ m!^/!; DEBUG && warn "-> Matched!\n"; my $orig_path_info = $env->{PATH_INFO}; my $orig_script_name = $env->{SCRIPT_NAME}; $env->{PATH_INFO} = $path; $env->{SCRIPT_NAME} = $script_name . $location; return $self->response_cb($app->($env), sub { $env->{PATH_INFO} = $orig_path_info; $env->{SCRIPT_NAME} = $orig_script_name; }); } DEBUG && warn "All matching failed.\n"; return [404, [ 'Content-Type' => 'text/plain' ], [ "Not Found" ]]; } 1; __END__ =head1 NAME Plack::App::URLMap - Map multiple apps in different paths =head1 SYNOPSIS use Plack::App::URLMap; my $app1 = sub { ... }; my $app2 = sub { ... }; my $app3 = sub { ... }; my $urlmap = Plack::App::URLMap->new; $urlmap->map("/" => $app1); $urlmap->map("/foo" => $app2); $urlmap->map("http://bar.example.com/" => $app3); my $app = $urlmap->to_app; =head1 DESCRIPTION Plack::App::URLMap is a PSGI application that can dispatch multiple applications based on URL path and host names (a.k.a "virtual hosting") and takes care of rewriting C and C (See L for details). This module is inspired by Ruby's Rack::URLMap. =head1 METHODS =over 4 =item map $urlmap->map("/foo" => $app); $urlmap->map("http://bar.example.com/" => $another_app); Maps URL path or an absolute URL to a PSGI application. The match order is sorted by host name length and then path length (longest strings first). URL paths need to match from the beginning and should match completely until the path separator (or the end of the path). For example, if you register the path C, it I match with the request C, C or C but it I match with C. Mapping URLs with host names is also possible, and in that case the URL mapping works like a virtual host. Mappings will nest. If $app is already mapped to C it will match a request for C but not C. See L for more details. =item mount Alias for C. =item to_app my $handler = $urlmap->to_app; Returns the PSGI application code reference. Note that the Plack::App::URLMap object is callable (by overloading the code dereference), so returning the object itself as a PSGI application should also work. =back =head1 PERFORMANCE If you C (or C with Plack::Builder) N applications, Plack::App::URLMap will need to at most iterate through N paths to match incoming requests. It is a good idea to use C only for a known, limited amount of applications, since mounting hundreds of applications could affect runtime request performance. =head1 DEBUGGING You can set the environment variable C to see how this application matches with the incoming request host names and paths. =head1 HOW THIS WORKS This application works by I C and C before dispatching the incoming request to the relocated applications. Say you have a Wiki application that takes C and C and makes a PSGI application C<$wiki_app> out of it, using one of supported web frameworks, you can put the whole application under C by: # MyWikiApp looks at PATH_INFO and handles /index and /page/* my $wiki_app = sub { MyWikiApp->run(@_) }; use Plack::App::URLMap; my $app = Plack::App::URLMap->new; $app->mount("/wiki" => $wiki_app); When a request comes in with C set to C, the URLMap application C<$app> strips the C part from C and B that to C. That way, if the C<$app> is mounted under the root (i.e. C is C<"">) with standalone web servers like L, C is now locally set to C and C is changed to C when C<$wiki_app> gets called. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L =cut Plack-1.0039/lib/Plack/App/WrapCGI.pm000644 000765 000024 00000006716 12631015706 017727 0ustar00miyagawastaff000000 000000 package Plack::App::WrapCGI; use strict; use warnings; use parent qw(Plack::Component); use Plack::Util::Accessor qw(script execute _app); use File::Spec; use CGI::Emulate::PSGI; use CGI::Compile; use Carp; use POSIX ":sys_wait_h"; sub slurp_fh { my $fh = $_[0]; local $/; my $v = <$fh>; defined $v ? $v : ''; } sub prepare_app { my $self = shift; my $script = $self->script or croak "'script' is not set"; $script = File::Spec->rel2abs($script); if ($self->execute) { my $app = sub { my $env = shift; pipe( my $stdoutr, my $stdoutw ); pipe( my $stdinr, my $stdinw ); my $pid = fork(); Carp::croak("fork failed: $!") unless defined $pid; if ($pid == 0) { # child local $SIG{__DIE__} = sub { print STDERR @_; exit(1); }; close $stdoutr; close $stdinw; local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); open( STDOUT, ">&=" . fileno($stdoutw) ) or Carp::croak "Cannot dup STDOUT: $!"; open( STDIN, "<&=" . fileno($stdinr) ) or Carp::croak "Cannot dup STDIN: $!"; chdir(File::Basename::dirname($script)); exec($script) or Carp::croak("cannot exec: $!"); exit(2); } close $stdoutw; close $stdinr; syswrite($stdinw, slurp_fh($env->{'psgi.input'})); # close STDIN so child will stop waiting close $stdinw; my $res = ''; while (waitpid($pid, WNOHANG) <= 0) { $res .= slurp_fh($stdoutr); } $res .= slurp_fh($stdoutr); if (POSIX::WIFEXITED($?)) { return CGI::Parse::PSGI::parse_cgi_output(\$res); } else { Carp::croak("Error at run_on_shell CGI: $!"); } }; $self->_app($app); } else { my $sub = CGI::Compile->compile($script); my $app = CGI::Emulate::PSGI->handler($sub); $self->_app($app); } } sub call { my($self, $env) = @_; $self->_app->($env); } 1; __END__ =head1 NAME Plack::App::WrapCGI - Compiles a CGI script as PSGI application =head1 SYNOPSIS use Plack::App::WrapCGI; my $app = Plack::App::WrapCGI->new(script => "/path/to/script.pl")->to_app; # if you want to execute as a real CGI script my $app = Plack::App::WrapCGI->new(script => "/path/to/script.rb", execute => 1)->to_app; =head1 DESCRIPTION Plack::App::WrapCGI compiles a CGI script into a PSGI application using L and L, and runs it with any PSGI server as a PSGI application. See also L if you have a directory that contains a lot of CGI scripts and serve them like Apache's mod_cgi. =head1 METHODS =over 4 =item new my $app = Plack::App::WrapCGI->new(%args); Creates a new PSGI application using the given script. I<%args> has two parameters: =over 8 =item script The path to a CGI-style program. This is a required parameter. =item execute An optional parameter. When set to a true value, this app will run the script with a CGI-style C/C model. Note that you may run programs written in other languages with this approach. =back =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L =cut Plack-1.0039/lib/HTTP/Message/000755 000765 000024 00000000000 12631015706 016514 5ustar00miyagawastaff000000 000000 Plack-1.0039/lib/HTTP/Server/000755 000765 000024 00000000000 12631015706 016376 5ustar00miyagawastaff000000 000000 Plack-1.0039/lib/HTTP/Server/PSGI.pm000644 000765 000024 00000024073 12631015706 017504 0ustar00miyagawastaff000000 000000 package HTTP::Server::PSGI; use strict; use warnings; use Carp (); use Plack; use Plack::HTTPParser qw( parse_http_request ); use IO::Socket::INET; use HTTP::Date; use HTTP::Status; use List::Util qw(max sum); use Plack::Util; use Stream::Buffered; use Plack::Middleware::ContentLength; use POSIX qw(EINTR); use Socket qw(IPPROTO_TCP TCP_NODELAY); use Try::Tiny; use Time::HiRes qw(time); my $alarm_interval; BEGIN { if ($^O eq 'MSWin32') { $alarm_interval = 1; } else { Time::HiRes->import('alarm'); $alarm_interval = 0.1; } } use constant MAX_REQUEST_SIZE => 131072; use constant MSWin32 => $^O eq 'MSWin32'; sub new { my($class, %args) = @_; my $self = bless { host => $args{host} || 0, port => $args{port} || 8080, timeout => $args{timeout} || 300, server_software => $args{server_software} || $class, server_ready => $args{server_ready} || sub {}, ssl => $args{ssl}, ipv6 => $args{ipv6}, ssl_key_file => $args{ssl_key_file}, ssl_cert_file => $args{ssl_cert_file}, }, $class; $self; } sub run { my($self, $app) = @_; $self->setup_listener(); $self->accept_loop($app); } sub prepare_socket_class { my($self, $args) = @_; if ($self->{ssl} && $self->{ipv6}) { Carp::croak("SSL and IPv6 are not supported at the same time (yet). Choose one."); } if ($self->{ssl}) { eval { require IO::Socket::SSL; 1 } or Carp::croak("SSL suport requires IO::Socket::SSL"); $args->{SSL_key_file} = $self->{ssl_key_file}; $args->{SSL_cert_file} = $self->{ssl_cert_file}; return "IO::Socket::SSL"; } elsif ($self->{ipv6}) { eval { require IO::Socket::IP; 1 } or Carp::croak("IPv6 support requires IO::Socket::IP"); $self->{host} ||= '::'; $args->{LocalAddr} ||= '::'; return "IO::Socket::IP"; } return "IO::Socket::INET"; } sub setup_listener { my $self = shift; my %args = ( Listen => SOMAXCONN, LocalPort => $self->{port}, LocalAddr => $self->{host}, Proto => 'tcp', ReuseAddr => 1, ); my $class = $self->prepare_socket_class(\%args); $self->{listen_sock} ||= $class->new(%args) or die "failed to listen to port $self->{port}: $!"; $self->{server_ready}->({ %$self, proto => $self->{ssl} ? 'https' : 'http' }); } sub accept_loop { my($self, $app) = @_; $app = Plack::Middleware::ContentLength->wrap($app); while (1) { local $SIG{PIPE} = 'IGNORE'; if (my $conn = $self->{listen_sock}->accept) { $conn->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1) or die "setsockopt(TCP_NODELAY) failed:$!"; my $env = { SERVER_PORT => $self->{port}, SERVER_NAME => $self->{host}, SCRIPT_NAME => '', REMOTE_ADDR => $conn->peerhost, REMOTE_PORT => $conn->peerport || 0, 'psgi.version' => [ 1, 1 ], 'psgi.errors' => *STDERR, 'psgi.url_scheme' => $self->{ssl} ? 'https' : 'http', 'psgi.run_once' => Plack::Util::FALSE, 'psgi.multithread' => Plack::Util::FALSE, 'psgi.multiprocess' => Plack::Util::FALSE, 'psgi.streaming' => Plack::Util::TRUE, 'psgi.nonblocking' => Plack::Util::FALSE, 'psgix.harakiri' => Plack::Util::TRUE, 'psgix.input.buffered' => Plack::Util::TRUE, 'psgix.io' => $conn, }; $self->handle_connection($env, $conn, $app); $conn->close; last if $env->{'psgix.harakiri.commit'}; } } } sub handle_connection { my($self, $env, $conn, $app) = @_; my $buf = ''; my $res = [ 400, [ 'Content-Type' => 'text/plain' ], [ 'Bad Request' ] ]; while (1) { my $rlen = $self->read_timeout( $conn, \$buf, MAX_REQUEST_SIZE - length($buf), length($buf), $self->{timeout}, ) or return; my $reqlen = parse_http_request($buf, $env); if ($reqlen >= 0) { $buf = substr $buf, $reqlen; if (my $cl = $env->{CONTENT_LENGTH}) { my $buffer = Stream::Buffered->new($cl); while ($cl > 0) { my $chunk; if (length $buf) { $chunk = $buf; $buf = ''; } else { $self->read_timeout($conn, \$chunk, $cl, 0, $self->{timeout}) or return; } $buffer->print($chunk); $cl -= length $chunk; } $env->{'psgi.input'} = $buffer->rewind; } else { open my $input, "<", \$buf; $env->{'psgi.input'} = $input; } $res = Plack::Util::run_app $app, $env; last; } if ($reqlen == -2) { # request is incomplete, do nothing } elsif ($reqlen == -1) { # error, close conn last; } } if (ref $res eq 'ARRAY') { $self->_handle_response($res, $conn); } elsif (ref $res eq 'CODE') { $res->(sub { $self->_handle_response($_[0], $conn); }); } else { die "Bad response $res"; } return; } sub _handle_response { my($self, $res, $conn) = @_; my @lines = ( "Date: @{[HTTP::Date::time2str()]}\015\012", "Server: $self->{server_software}\015\012", ); Plack::Util::header_iter($res->[1], sub { my ($k, $v) = @_; push @lines, "$k: $v\015\012"; }); unshift @lines, "HTTP/1.0 $res->[0] @{[ HTTP::Status::status_message($res->[0]) ]}\015\012"; push @lines, "\015\012"; $self->write_all($conn, join('', @lines), $self->{timeout}) or return; if (defined $res->[2]) { my $err; my $done; { local $@; eval { Plack::Util::foreach( $res->[2], sub { $self->write_all($conn, $_[0], $self->{timeout}) or die "failed to send all data\n"; }, ); $done = 1; }; $err = $@; }; unless ($done) { if ($err =~ /^failed to send all data\n/) { return; } else { die $err; } } } else { return Plack::Util::inline_object write => sub { $self->write_all($conn, $_[0], $self->{timeout}) }, close => sub { }; } } # returns 1 if socket is ready, undef on timeout sub do_timeout { my ($self, $cb, $timeout) = @_; local $SIG{ALRM} = sub {}; my $wait_until = time + $timeout; alarm($timeout); my $ret; while (1) { if ($ret = $cb->()) { last; } elsif (! (! defined($ret) && $! == EINTR)) { undef $ret; last; } # got EINTR my $left = $wait_until - time; last if $left <= 0; alarm($left + $alarm_interval); } alarm(0); $ret; } # returns (positive) number of bytes read, or undef if the socket is to be closed sub read_timeout { my ($self, $sock, $buf, $len, $off, $timeout) = @_; $self->do_timeout(sub { $sock->sysread($$buf, $len, $off) }, $timeout); } # returns (positive) number of bytes written, or undef if the socket is to be closed sub write_timeout { my ($self, $sock, $buf, $len, $off, $timeout) = @_; $self->do_timeout(sub { $sock->syswrite($buf, $len, $off) }, $timeout); } # writes all data in buf and returns number of bytes written or undef if failed sub write_all { my ($self, $sock, $buf, $timeout) = @_; return 0 unless defined $buf; _encode($buf); my $off = 0; while (my $len = length($buf) - $off) { my $ret = $self->write_timeout($sock, $buf, $len, $off, $timeout) or return; $off += $ret; } return length $buf; } # syswrite() will crash when given wide characters sub _encode { if ($_[0] =~ /[^\x00-\xff]/) { Carp::carp("Wide character outside byte range in response. Encoding data as UTF-8"); utf8::encode($_[0]); } } 1; __END__ =head1 NAME HTTP::Server::PSGI - Standalone PSGI compatible HTTP server =head1 SYNOPSIS use HTTP::Server::PSGI; my $server = HTTP::Server::PSGI->new( host => "127.0.0.1", port => 9091, timeout => 120, ); $server->run($app); =head1 DESCRIPTION HTTP::Server::PSGI is a standalone, single-process and PSGI compatible HTTP server implementations. This server should be great for the development and testing, but might not be suitable for a production use. Some features in HTTP/1.1, notably chunked requests, responses and pipeline requests are B supported, and it also does not support HTTP/0.9. See L or uWSGI server if you want HTTP/1.1 and other features ready for a production use. =head1 PREFORKING L does B support preforking. See L or L if you want a multi-process prefork web servers. =head1 HARAKIRI SUPPORT This web server supports `psgix.harakiri` extension defined in the L. This application is a non-forking single process web server (i.e. `psgi.multiprocess` is false), and if your application commits harakiri, the entire web server stops too. In case this behavior is not what you want, be sure to check `psgi.multiprocess` as well to enable harakiri only in the preforking servers such as L. On the other hand, this behavior might be handy if you want to embed this module in your application and serve HTTP requests for only short period of time, then go back to your main program. =head1 AUTHOR Kazuho Oku Tatsuhiko Miyagawa =head1 SEE ALSO L L L =cut Plack-1.0039/lib/HTTP/Message/PSGI.pm000644 000765 000024 00000015137 12631015706 017623 0ustar00miyagawastaff000000 000000 package HTTP::Message::PSGI; use strict; use warnings; use parent qw(Exporter); our @EXPORT = qw( req_to_psgi res_from_psgi ); use Carp (); use HTTP::Status qw(status_message); use URI::Escape (); use Plack::Util; use Try::Tiny; my $TRUE = (1 == 1); my $FALSE = !$TRUE; sub req_to_psgi { my $req = shift; unless (try { $req->isa('HTTP::Request') }) { Carp::croak("Request is not HTTP::Request: $req"); } # from HTTP::Request::AsCGI my $host = $req->header('Host'); my $uri = $req->uri->clone; $uri->scheme('http') unless $uri->scheme; $uri->host('localhost') unless $uri->host; $uri->port(80) unless $uri->port; $uri->host_port($host) unless !$host || ( $host eq $uri->host_port ); my $input; my $content = $req->content; if (ref $content eq 'CODE') { if (defined $req->content_length) { $input = HTTP::Message::PSGI::ChunkedInput->new($content); } else { $req->header("Transfer-Encoding" => "chunked"); $input = HTTP::Message::PSGI::ChunkedInput->new($content, 1); } } else { open $input, "<", \$content; $req->content_length(length $content) unless defined $req->content_length; } my $env = { PATH_INFO => URI::Escape::uri_unescape($uri->path || '/'), QUERY_STRING => $uri->query || '', SCRIPT_NAME => '', SERVER_NAME => $uri->host, SERVER_PORT => $uri->port, SERVER_PROTOCOL => $req->protocol || 'HTTP/1.1', REMOTE_ADDR => '127.0.0.1', REMOTE_HOST => 'localhost', REMOTE_PORT => int( rand(64000) + 1000 ), # not in RFC 3875 REQUEST_URI => $uri->path_query || '/', # not in RFC 3875 REQUEST_METHOD => $req->method, 'psgi.version' => [ 1, 1 ], 'psgi.url_scheme' => $uri->scheme eq 'https' ? 'https' : 'http', 'psgi.input' => $input, 'psgi.errors' => *STDERR, 'psgi.multithread' => $FALSE, 'psgi.multiprocess' => $FALSE, 'psgi.run_once' => $TRUE, 'psgi.streaming' => $TRUE, 'psgi.nonblocking' => $FALSE, @_, }; for my $field ( $req->headers->header_field_names ) { my $key = uc("HTTP_$field"); $key =~ tr/-/_/; $key =~ s/^HTTP_// if $field =~ /^Content-(Length|Type)$/; unless ( exists $env->{$key} ) { $env->{$key} = $req->headers->header($field); } } if ($env->{SCRIPT_NAME}) { $env->{PATH_INFO} =~ s/^\Q$env->{SCRIPT_NAME}\E/\//; $env->{PATH_INFO} =~ s/^\/+/\//; } if (!defined($env->{HTTP_HOST}) && $req->uri->can('host')) { $env->{HTTP_HOST} = $req->uri->host; $env->{HTTP_HOST} .= ':' . $req->uri->port if $req->uri->port ne $req->uri->default_port; } return $env; } sub res_from_psgi { my ($psgi_res) = @_; require HTTP::Response; my $res; if (ref $psgi_res eq 'ARRAY') { _res_from_psgi($psgi_res, \$res); } elsif (ref $psgi_res eq 'CODE') { $psgi_res->(sub { _res_from_psgi($_[0], \$res); }); } else { Carp::croak("Bad response: ", defined $psgi_res ? $psgi_res : 'undef'); } return $res; } sub _res_from_psgi { my ($status, $headers, $body) = @{+shift}; my $res_ref = shift; my $convert_resp = sub { my $res = HTTP::Response->new($status); $res->message(status_message($status)); $res->headers->header(@$headers) if @$headers; if (ref $body eq 'ARRAY') { $res->content(join '', grep defined, @$body); } else { local $/ = \4096; my $content = ''; while (defined(my $buf = $body->getline)) { $content .= $buf; } $body->close; $res->content($content); } ${ $res_ref } = $res; return; }; if (!defined $body) { my $o = Plack::Util::inline_object write => sub { push @{ $body ||= [] }, @_ }, close => $convert_resp; return $o; } $convert_resp->(); } sub HTTP::Request::to_psgi { req_to_psgi(@_); } sub HTTP::Response::from_psgi { my $class = shift; res_from_psgi(@_); } package HTTP::Message::PSGI::ChunkedInput; sub new { my($class, $content, $chunked) = @_; my $content_cb; if ($chunked) { my $done; $content_cb = sub { my $chunk = $content->(); return if $done; unless (defined $chunk) { $done = 1; return "0\015\012\015\012"; } return '' unless length $chunk; return sprintf('%x', length $chunk) . "\015\012$chunk\015\012"; }; } else { $content_cb = $content; } bless { content => $content_cb }, $class; } sub read { my $self = shift; my $chunk = $self->{content}->(); return 0 unless defined $chunk; $_[0] = ''; substr($_[0], $_[2] || 0, length $chunk) = $chunk; return length $chunk; } sub close { } package HTTP::Message::PSGI; 1; __END__ =head1 NAME HTTP::Message::PSGI - Converts HTTP::Request and HTTP::Response from/to PSGI env and response =head1 SYNOPSIS use HTTP::Message::PSGI; # $req is HTTP::Request, $res is HTTP::Response my $env = req_to_psgi($req); my $res = res_from_psgi([ $status, $headers, $body ]); # Adds methods to HTTP::Request/Response class as well my $env = $req->to_psgi; my $res = HTTP::Response->from_psgi([ $status, $headers, $body ]); =head1 DESCRIPTION HTTP::Message::PSGI gives you convenient methods to convert an L object to a PSGI env hash and convert a PSGI response arrayref to a L object. If you want the other way around, see L and L. =head1 METHODS =over 4 =item req_to_psgi my $env = req_to_psgi($req [, $key => $val ... ]); Converts a L object into a PSGI env hash reference. =item HTTP::Request::to_psgi my $env = $req->to_psgi; Same as C but an instance method in L. =item res_from_psgi my $res = res_from_psgi([ $status, $headers, $body ]); Creates a L object from a PSGI response array ref. =item HTTP::Response->from_psgi my $res = HTTP::Response->from_psgi([ $status, $headers, $body ]); Same as C, but is a class method in L. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L L L =cut Plack-1.0039/eg/dot-psgi/000755 000765 000024 00000000000 12631015706 015724 5ustar00miyagawastaff000000 000000 Plack-1.0039/eg/dot-psgi/cgi-pm.psgi000644 000765 000024 00000000406 12631015706 017764 0ustar00miyagawastaff000000 000000 use CGI::PSGI; sub { my $env = shift; my $query = CGI::PSGI->new($env); # return [ 200, [ "Content-Type" => "text/plain" ], [ "Hello ", $query->param('name') ] ]; return [ $query->psgi_header('text/plain'), [ "Hello ", $query->param('name') ] ]; }Plack-1.0039/eg/dot-psgi/cgi-script.psgi000644 000765 000024 00000000243 12631015706 020653 0ustar00miyagawastaff000000 000000 use CGI::Emulate::PSGI; my $handler = CGI::Emulate::PSGI->handler(sub { do "hello.cgi"; CGI::initialize_globals() if defined &CGI::initialize_globals; }); Plack-1.0039/eg/dot-psgi/Dumper.psgi000644 000765 000024 00000000207 12631015706 020043 0ustar00miyagawastaff000000 000000 use Data::Dumper; my $handler = sub { my $env = shift; return [ 200, [ "Content-Type" => "text/plain" ], [ Dumper $env ] ]; }; Plack-1.0039/eg/dot-psgi/echo-stream-sync.psgi000644 000765 000024 00000000417 12631015706 021773 0ustar00miyagawastaff000000 000000 my $app = sub { my $env = shift; return sub { my $respond = shift; my $w = $respond->([ 200, ['X-Foo' => 'bar', 'Content-Type' => 'text/plain'] ]); for (1..5) { sleep 1; $w->write(time . "\n"); } }; }; Plack-1.0039/eg/dot-psgi/echo-stream.psgi000644 000765 000024 00000000736 12631015706 021025 0ustar00miyagawastaff000000 000000 use AnyEvent; my $app = sub { my $env = shift; warn "This app needs a server that supports psgi.streaming" unless $env->{'psgi.streaming'}; return sub { my $respond = shift; my $w = $respond->([ 200, ['X-Foo' => 'bar', 'Content-Type' => 'text/plain'] ]); my $t; $t = AE::timer 0, 1, sub { $t; # TODO handle client disconnect (broken pipe) and poll_cb $w->write(time . "\n"); }; }; }; Plack-1.0039/eg/dot-psgi/echo.psgi000644 000765 000024 00000000623 12631015706 017527 0ustar00miyagawastaff000000 000000 my $app = sub { my $env = shift; warn "This app would block with sleep(): try echo-stream.psgi" if $env->{'psgi.nonblocking'}; my $count; my $body = Plack::Util::inline_object getline => sub { return if $count++ > 5; sleep 1; return time . "\n"; }, close => sub {}; return [ 200, ['X-Foo' => 'bar'], $body ]; }; Plack-1.0039/eg/dot-psgi/error.psgi000644 000765 000024 00000000200 12631015706 017731 0ustar00miyagawastaff000000 000000 sub { my $x = "bar"; my $y = [1,2,3]; my $z = { x => 1 }; my @y = qw(foo bar); my %z = (x => 1, y => 2); die "Oops"; }; Plack-1.0039/eg/dot-psgi/Hello.psgi000644 000765 000024 00000000172 12631015706 017653 0ustar00miyagawastaff000000 000000 my $handler = sub { return [ 200, [ "Content-Type" => "text/plain", "Content-Length" => 11 ], [ "Hello World" ] ]; }; Plack-1.0039/eg/dot-psgi/image.psgi000644 000765 000024 00000000434 12631015706 017673 0ustar00miyagawastaff000000 000000 use File::Basename; my $path = $ENV{PSGI_IMAGE_FILE} || dirname(__FILE__) . "/../../share/baybridge.jpg"; my $handler = sub { open my $fh, "<:raw", $path or die $!; return [ 200, [ "Content-Type" => "image/jpeg", "X-Sendfile" => $path, "Content-Length" => -s $fh ], $fh ]; }; Plack-1.0039/eg/dot-psgi/nonblock-hello.psgi000644 000765 000024 00000000763 12631015706 021524 0ustar00miyagawastaff000000 000000 use AnyEvent; my $app = sub { my $env = shift; warn "This app needs a server that supports psgi.streaming and psgi.nonblocking" unless $env->{'psgi.streaming'} && $env->{'psgi.nonblocking'}; return sub { my $respond = shift; my $w = $respond->([ 200, ['Content-Type' => 'text/plain'] ]); $w->write("Hello\n"); my $t; $t = AE::timer 2, 0, sub { undef $t; $w->write("World\n"); $w->close; }; }; }; Plack-1.0039/eg/dot-psgi/plack-req.psgi000644 000765 000024 00000000400 12631015706 020461 0ustar00miyagawastaff000000 000000 use Plack::Request; use Plack::Response; sub { my $env = shift; my $req = Plack::Request->new($env); my $res = $req->new_response(200); $res->content_type('text/plain'); $res->body("Hello " . $req->param('name')); $res->finalize; } Plack-1.0039/eg/dot-psgi/runnable.psgi000755 000765 000024 00000000335 12631015706 020422 0ustar00miyagawastaff000000 000000 #!/usr/bin/perl unless (caller) { require Plack::Runner; Plack::Runner->run(@ARGV, $0); } my $handler = sub { return [ 200, [ "Content-Type" => "text/plain", "Content-Length" => 11 ], [ "Hello World" ] ]; }; Plack-1.0039/eg/dot-psgi/slowapp.psgi000644 000765 000024 00000001141 12631015706 020272 0ustar00miyagawastaff000000 000000 # emulate a slow web app that does DB query etc. use Time::HiRes; sub _sleep { # If it's running in Coro, you can use Coro's co-operative multi # tasking to do time-consuming task by yeilding to other threads: # we use Coro::Timer::sleep to demonstrate that: if ($INC{"Coro.pm"}) { require Coro::Timer; Coro::Timer::sleep( $_[0] ); } else { Time::HiRes::sleep( $_[0] ); } } my $handler = sub { _sleep 0.1; # emulate the DB/IO task that takes 0.1 second return [ 200, [ "Content-Type" => "text/plain", "Content-Length" => 11 ], [ "Hello World" ] ]; }; Plack-1.0039/eg/dot-psgi/static/000755 000765 000024 00000000000 12631015706 017213 5ustar00miyagawastaff000000 000000 Plack-1.0039/eg/dot-psgi/static.psgi000644 000765 000024 00000000507 12631015706 020101 0ustar00miyagawastaff000000 000000 use Plack::Builder; use File::Basename qw(dirname); my $handler = sub { return [ 404, [ "Content-Type" => "text/plain" ], [ "Not Found" ] ]; }; builder { enable "Plack::Middleware::ConditionalGET"; enable "Plack::Middleware::Static", path => qr/./, root => dirname(__FILE__) . '/static'; $handler; }; Plack-1.0039/eg/dot-psgi/twitter-stream.psgi000644 000765 000024 00000001274 12631015706 021607 0ustar00miyagawastaff000000 000000 use AnyEvent::Twitter::Stream; use Encode; my $app = sub { my $env = shift; my $keyword = $env->{PATH_INFO}; $keyword =~ s!^/!!; my $cb = sub { }; # track keywords my $guard = AnyEvent::Twitter::Stream->new( username => $ENV{TWITTER_USERNAME}, password => $ENV{TWITTER_PASSWORD}, method => "filter", track => $keyword || "twitter", on_tweet => sub { $cb->(@_) }, ); return sub { my $respond = shift; my $w = $respond->([ 200, ['Content-Type' => 'text/plain'] ]); $cb = sub { my $tweet = shift; $w->write(Encode::encode_utf8($tweet->{text}) . "\n"); }; }; }; Plack-1.0039/eg/dot-psgi/static/index.html000644 000765 000024 00000000231 12631015706 021204 0ustar00miyagawastaff000000 000000 Hello Plack-1.0039/eg/dot-psgi/static/test.css000644 000765 000024 00000000031 12631015706 020676 0ustar00miyagawastaff000000 000000 body { font-size: 20px } Plack-1.0039/eg/dot-psgi/static/test.js000644 000765 000024 00000000021 12631015706 020521 0ustar00miyagawastaff000000 000000 function foo() {}Plack-1.0039/benchmarks/ab.pl000755 000765 000024 00000003266 12631015706 016651 0ustar00miyagawastaff000000 000000 #!/usr/bin/perl use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Plack::Loader; use Test::TCP; use Getopt::Long; use URI; use String::ShellQuote; my $app = 'eg/dot-psgi/Hello.psgi'; my $ab = 'ab -t 1 -c 10 -k -q'; my $url = 'http://127.0.0.1/'; my @try = ( [ 'AnyEvent::HTTPD' ], [ 'HTTP::Server::PSGI' ], [ 'Twiggy' ], [ 'HTTP::Server::Simple' ], [ 'Corona' ], [ 'Danga::Socket' ], [ '+POE::Component::Server::PSGI' ], [ 'Starlet', ' (workers=10)', max_workers => 10 ], [ 'Starman', ' (workers=10)', workers => 10 ], [ 'Feersum' ], ); my @backends; for my $handler (@try) { eval { Plack::Loader->load($handler->[0]) }; push @backends, $handler unless $@; } warn "Testing implementations: ", join(", ", map $_->[0], @backends), "\n"; GetOptions( 'a|app=s' => \$app, 'b|bench=s' => \$ab, 'u|url=s' => \$url, ) or die; &main; sub main { print < sub { my $port = shift; my $uri = URI->new($url); $uri->port($port); $uri = shell_quote($uri); system "ab -n 20 $uri > /dev/null"; # warmup print `$ab $uri | grep 'Requests per '`; }, server => sub { my $port = shift; my $handler = Plack::Util::load_psgi $app; my $server = Plack::Loader->load($server_class, port => $port, @args); $server->run($handler); }, ); } Plack-1.0039/benchmarks/fcgi.pl000755 000765 000024 00000001766 12631015706 017202 0ustar00miyagawastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use autodie; use FCGI::Client; use Plack::Loader; use Getopt::Long; use Pod::Usage; use File::Temp (); use IO::Socket::UNIX; use Benchmark ':all'; my %opts = (app => "eg/dot-psgi/Hello.psgi"); GetOptions(\%opts, "app=s", "impl=s", "help"); pod2usage(0) if $opts{help}; my $fname = File::Temp::tmpnam(); my $env = +{ }; my $content = ''; my $pid = fork(); if ($pid > 0) { timethis( 10000 => sub { my $sock = IO::Socket::UNIX->new( Peer => $fname ) or die $!; my $conn = FCGI::Client::Connection->new( sock => $sock ); my ( $stdout, $stderr ) = $conn->request( $env, $content ); } ); kill 9, $pid; wait; } else { my $sock = IO::Socket::UNIX->new( Local => $fname, Listen => 10 ) or die $!; open *STDIN, '>&', $sock; # dup my $handler = Plack::Util::load_psgi($opts{app}); my $impl = Plack::Loader->load('FCGI'); $impl->run($handler); die 'should not reach here'; }