Plack-1.0048000755000765000024 013761035266 12734 5ustar00miyagawastaff000000000000README100644000765000024 1430713761035266 13722 0ustar00miyagawastaff000000000000Plack-1.0048NAME 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. Changes100644000765000024 15152513761035266 14361 0ustar00miyagawastaff000000000000Plack-1.0048Go to http://github.com/plack/Plack/issues for the roadmap and known issues. 1.0048 2020-11-29 16:20:00 PST [IMPROVEMENTS] - Updated documentation for cotent_length and content_type #625 - Allow hyphens in file extensions for custom MIME types #614 - Updated some python test script to work with Python 3 #639 [BUG FIXES] - Fix HTTP::Message::PSGI to work with delayed writer without content #653 - Plackup reloader allows restarting the server when the path contains .git or .svn, just not at the beginning of the path #632 - Added MIME types for .webp, .ttf and .xlsx files (rrwo) - Fix Plack::Request content to not error when Content-Type is empty #655 1.0047 2018-02-10 01:23:37 PST [BUG FIXES] - Disable FCGI/lighttpd test that was supposed to be releng only #611 1.0046 2018-02-09 23:51:10 PST [NEW FEATURES] - Support psgix.cleanup and psgix.harakiri in FCGI handler (afresh1) #610 [IMPROVEMENTS] - Do not set TCP_NODELAY when it's unavailable in embedded systems (dex4er) #579 1.0045 2017-12-31 12:40:52 PST [BUG FIXES] - Protect WrapCGI against SIGCHLD handlers #596 [IMPROVEMENTS] - Set Content-Length to 0 in XSendfile middleware #602 - Document options for XSendfile middleware - Remove #foo file for testing that was causing issues on Win32 systems #599 - Add 103 Early Hints to Plack::Handler::CGI 1.0044 2017-04-26 22:30:27 PDT [IMPROVEMENTS] - Allow passing an already-open listen socket to HTTP::Server::PSGI and add an option to do so in Plack::Test::Server. 1.0043 2017-02-21 19:00:31 PST [IMPROVEMENTS] - Fixed typo in docs #578 #584 - Remove test that expects cookie to be delimited by comma #573 - Stop upper-casing all header keys in Plack::Request->headers #585 1.0042 2016-09-28 22:37:33 PDT [BUG FIXES] - Revert: Allow passing an already-open listen socket to HTTP::Server::PSGI #550 1.0041 2016-09-25 14:24:07 PDT [BUG FIXES] - Fix ConditionalGET middleware in case both Last-Modified and ETag exist. #569 - Handle Cookie values with quotes correctly (alh, kazeburo) #564, #567 [IMPROVEMENTS] - Several documentation fixes and error message improvements #556, #557, #558, #559 1.0040 2016-04-01 09:57:06 PDT [INCOMPATIBLE CHANGES] - Fixes a mistake in the value of %D and %T in Accesslog::Timed middleware. This is due to a bug in Apache::LogFormat::Compiler that sets a wrong value for these fields. This bug has been fixed and now it emits what the documentation has always said, in the same way as how Apache's log format works. However, this is a BREAKING CHANGE if you are using '%D' or '%T' in your log formats, and you'll likely need to swap them if you need the same values as previously. Read https://github.com/plack/Plack/issues/549 for more details. (astj) #549, #551 [IMPROVEMENTS] - Remove the use of HTTP::Body in favor of HTTP::Entity::Parser (kazeburo) #538 - Increase the buffer size to 1MB for requests already buffered by the PSGI server - Allow passing an already-open listen socket to HTTP::Server::PSGI (ilmari) #550 [BUG FIXES] - Lint middleware now allows blessed code refs as a PSGI app (smcmurray) #542 - Fix log4perl tests to pass when running in parallel (rsimoes) #545 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 LICENSE100644000765000024 4371613761035266 14055 0ustar00miyagawastaff000000000000Plack-1.0048This 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 cpanfile100644000765000024 266013761035266 14525 0ustar00miyagawastaff000000000000Plack-1.0048requires 'perl', '5.008001'; requires 'Cookie::Baker', '0.07'; requires 'Devel::StackTrace', '1.23'; requires 'Devel::StackTrace::AsHTML', '0.11'; requires 'File::ShareDir', '1.00'; requires 'Filesys::Notify::Simple'; 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.15'; requires 'Try::Tiny'; requires 'URI', '1.59'; requires 'parent'; requires 'Apache::LogFormat::Compiler', '0.33'; requires 'HTTP::Tiny', 0.034; requires 'HTTP::Entity::Parser', 0.25; requires 'WWW::Form::UrlEncoded', 0.23; on test => sub { requires 'Test::More', '0.88'; requires 'Test::Requires'; suggests 'Test::MockTime::HiRes', '0.06'; suggests 'Authen::Simple::Passwd'; suggests 'MIME::Types'; suggests 'CGI::Emulate::PSGI'; suggests 'CGI::Compile'; suggests 'IO::Handle::Util'; suggests 'LWP::Protocol::http10'; suggests 'HTTP::Server::Simple::PSGI'; suggests 'HTTP::Request::AsCGI'; suggests 'LWP::UserAgent', '5.814'; suggests 'HTTP::Headers'; suggests 'Log::Dispatch::Array'; }; on runtime => sub { suggests 'FCGI'; suggests 'FCGI::ProcManager'; suggests 'CGI::Emulate::PSGI'; suggests 'CGI::Compile'; suggests 'LWP::UserAgent', '5.814'; suggests 'Log::Log4perl'; suggests 'Log::Dispatch', '2.25'; suggests 'Module::Refresh'; }; dist.ini100644000765000024 10713761035266 14437 0ustar00miyagawastaff000000000000Plack-1.0048[@Milla] installer = MakeMaker [Metadata] x_authority = cpan:MIYAGAWA META.yml100644000765000024 1566413761035266 14322 0ustar00miyagawastaff000000000000Plack-1.0048--- 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::Milla version v1.0.20, Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.143240' 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.33' Cookie::Baker: '0.07' Devel::StackTrace: '1.23' Devel::StackTrace::AsHTML: '0.11' File::ShareDir: '1.00' Filesys::Notify::Simple: '0' HTTP::Entity::Parser: '0.25' 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.15' Try::Tiny: '0' URI: '1.59' WWW::Form::UrlEncoded: '0.23' 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.0048' x_authority: cpan:MIYAGAWA x_contributors: - 'Aaron Trevena ' - 'Ævar Arnfjörð Bjarmason ' - 'Akzhan Abdulin ' - 'Alexandr Ciornii ' - 'Alex J. G. BurzyÅ„ski ' - 'Allan Whiteford ' - 'Andrew Fresh ' - 'Andrew Rodland ' - 'Andy Wardley ' - 'Aristotle Pagaltzis ' - "Arthur Axel 'fREW' Schmidt " - 'Asato Wakisaka ' - 'Ashley Pond V ' - 'Ask Bjørn Hansen ' - 'ben hengst ' - 'Ben Morrow ' - 'Bernhard Graf ' - 'Chad Granum ' - 'chansen ' - 'Chia-liang Kao ' - 'cho45 ' - 'Christian Walde ' - 'chromatic ' - 'Cosimo Streppone ' - 'Dagfinn Ilmari MannsÃ¥ker ' - 'Daisuke Maki ' - 'Daisuke Murase ' - 'Dave Marr ' - 'Dave Rolsky ' - 'David E. Wheeler ' - 'David Schmidt ' - 'David Steinbrunner ' - 'dmaestro ' - 'Eduardo Arino de la Rubia ' - 'Emmanuel Seyman ' - 'Eric Johnson ' - 'Eugen Konkov ' - 'Fabrice Gabolde ' - 'Fabrice Gabolde ' - 'fayland ' - 'Flavio Poletti ' - 'Florian Ragwitz ' - 'franck cuny ' - 'Gianni Ceccarelli ' - '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 ' - 'Marco Pessotto ' - 'Marian Schubert ' - 'Mark Fowler ' - 'Mark Stosberg ' - 'Masahiro Chiba ' - 'Masahiro Nagano ' - 'Michael G. Schwern ' - 'Michal Josef Å paÄek ' - 'mickey ' - 'Narsimham Chelluri ' - 'Narsimham Chelluri ' - 'Nick Wellnhofer ' - 'Nobuo Danjou ' - 'Olaf Alders ' - 'Oliver Gorwits ' - 'Oliver Paukstadt ' - 'Oliver Trosien ' - 'Olivier Mengué ' - 'osfameron ' - 'Panu Ervamaa ' - 'Paul Driver ' - 'Pedro Melo ' - 'Perlover ' - 'Peter Flanigan ' - 'Peter Makholm ' - 'Piotr Roszatycki ' - 'punytan ' - 'Rafael Kitover ' - 'Randy Stauner ' - 'Ray Miller ' - 'Richard Simões ' - 'Ricky Morse ' - 'Robert Rothenberg ' - 'Rob Hoelz ' - 'runarb ' - 'Ryo Miyake ' - 'Sawyer X ' - 'Scott S. McCoy ' - 'Shawn M Moore ' - 'Shoichi Kaji ' - 'smcmurray ' - 'Stephen Clouse ' - 'Stevan Little ' - 'Stuart A Johnston ' - 'Takeshi OKURA ' - 'Tatsuhiko Miyagawa ' - 'The Dumb Terminal ' - 'Thomas Klausner ' - 'Thomas Sibley ' - 'Tim Bunce ' - 'Tokuhiro Matsuno ' - 'Tomas Doran ' - 'Tom Heady ' - 'vti ' - 'Wallace Reis ' - 'xaicron ' - 'Yann Kerherve ' - 'yappo ' - 'Yury Zavarin ' - 'Yuval Kogman ' - 'å”é³³ ' x_generated_by_perl: v5.20.1 x_serialization_backend: 'YAML::Tiny version 1.73' x_static_install: 1 MANIFEST100644000765000024 1772013761035266 14175 0ustar00miyagawastaff000000000000Plack-1.0048# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. 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/baybridge.jpg share/face.jpg t/HTTP-Message-PSGI/content_length.t t/HTTP-Message-PSGI/empty_delayed_writer.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/listen.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/FCGIUtils.pm 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/fcgi_cleanup.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/lint_wrong_header_info.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-unbuffered.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/headers.t 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/headers.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 META.json100644000765000024 2243313761035266 14462 0ustar00miyagawastaff000000000000Plack-1.0048{ "abstract" : "Perl Superglue for Web frameworks and Web Servers (PSGI toolkit)", "author" : [ "Tatsuhiko Miyagawa" ], "dynamic_config" : 0, "generated_by" : "Dist::Milla version v1.0.20, Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.143240", "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" }, "suggests" : { "JSON::PP" : "2.27300" } }, "develop" : { "requires" : { "Dist::Milla" : "v1.0.20", "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Apache::LogFormat::Compiler" : "0.33", "Cookie::Baker" : "0.07", "Devel::StackTrace" : "1.23", "Devel::StackTrace::AsHTML" : "0.11", "File::ShareDir" : "1.00", "Filesys::Notify::Simple" : "0", "HTTP::Entity::Parser" : "0.25", "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.15", "Try::Tiny" : "0", "URI" : "1.59", "WWW::Form::UrlEncoded" : "0.23", "parent" : "0", "perl" : "5.008001" }, "suggests" : { "CGI::Compile" : "0", "CGI::Emulate::PSGI" : "0", "FCGI" : "0", "FCGI::ProcManager" : "0", "LWP::UserAgent" : "5.814", "Log::Dispatch" : "2.25", "Log::Log4perl" : "0", "Module::Refresh" : "0" } }, "test" : { "requires" : { "Test::More" : "0.88", "Test::Requires" : "0" }, "suggests" : { "Authen::Simple::Passwd" : "0", "CGI::Compile" : "0", "CGI::Emulate::PSGI" : "0", "HTTP::Headers" : "0", "HTTP::Request::AsCGI" : "0", "HTTP::Server::Simple::PSGI" : "0", "IO::Handle::Util" : "0", "LWP::Protocol::http10" : "0", "LWP::UserAgent" : "5.814", "Log::Dispatch::Array" : "0", "MIME::Types" : "0", "Test::MockTime::HiRes" : "0.06" } } }, "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.0048", "x_authority" : "cpan:MIYAGAWA", "x_contributors" : [ "Aaron Trevena ", "\u00c6var Arnfj\u00f6r\u00f0 Bjarmason ", "Akzhan Abdulin ", "Alexandr Ciornii ", "Alex J. G. Burzy\u0144ski ", "Allan Whiteford ", "Andrew Fresh ", "Andrew Rodland ", "Andy Wardley ", "Aristotle Pagaltzis ", "Arthur Axel 'fREW' Schmidt ", "Asato Wakisaka ", "Ashley Pond V ", "Ask Bj\u00f8rn Hansen ", "ben hengst ", "Ben Morrow ", "Bernhard Graf ", "Chad Granum ", "chansen ", "Chia-liang Kao ", "cho45 ", "Christian Walde ", "chromatic ", "Cosimo Streppone ", "Dagfinn Ilmari Manns\u00e5ker ", "Daisuke Maki ", "Daisuke Murase ", "Dave Marr ", "Dave Rolsky ", "David E. Wheeler ", "David Schmidt ", "David Steinbrunner ", "dmaestro ", "Eduardo Arino de la Rubia ", "Emmanuel Seyman ", "Eric Johnson ", "Eugen Konkov ", "Fabrice Gabolde ", "Fabrice Gabolde ", "fayland ", "Flavio Poletti ", "Florian Ragwitz ", "franck cuny ", "Gianni Ceccarelli ", "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\u0301 Pinheiro Neta ", "Justin Davis ", "kakuno ", "Kang-min Liu ", "Karen Etheridge ", "Kazuho Oku ", "Keedi Kim ", "Lee Aylward ", "Leo Lapworth ", "mala ", "Marco Pessotto ", "Marian Schubert ", "Mark Fowler ", "Mark Stosberg ", "Masahiro Chiba ", "Masahiro Nagano ", "Michael G. Schwern ", "Michal Josef \u0160pa\u010dek ", "mickey ", "Narsimham Chelluri ", "Narsimham Chelluri ", "Nick Wellnhofer ", "Nobuo Danjou ", "Olaf Alders ", "Oliver Gorwits ", "Oliver Paukstadt ", "Oliver Trosien ", "Olivier Mengu\u00e9 ", "osfameron ", "Panu Ervamaa ", "Paul Driver ", "Pedro Melo ", "Perlover ", "Peter Flanigan ", "Peter Makholm ", "Piotr Roszatycki ", "punytan ", "Rafael Kitover ", "Randy Stauner ", "Ray Miller ", "Richard Sim\u00f5es ", "Ricky Morse ", "Robert Rothenberg ", "Rob Hoelz ", "runarb ", "Ryo Miyake ", "Sawyer X ", "Scott S. McCoy ", "Shawn M Moore ", "Shoichi Kaji ", "smcmurray ", "Stephen Clouse ", "Stevan Little ", "Stuart A Johnston ", "Takeshi OKURA ", "Tatsuhiko Miyagawa ", "The Dumb Terminal ", "Thomas Klausner ", "Thomas Sibley ", "Tim Bunce ", "Tokuhiro Matsuno ", "Tomas Doran ", "Tom Heady ", "vti ", "Wallace Reis ", "xaicron ", "Yann Kerherve ", "yappo ", "Yury Zavarin ", "Yuval Kogman ", "\u5510\u9cf3 " ], "x_generated_by_perl" : "v5.20.1", "x_serialization_backend" : "Cpanel::JSON::XS version 4.09", "x_static_install" : 1 } t000755000765000024 013761035266 13120 5ustar00miyagawastaff000000000000Plack-1.0048test.txt100644000765000024 413761035266 14712 0ustar00miyagawastaff000000000000Plack-1.0048/tfoo Makefile.PL100644000765000024 547713761035266 15004 0ustar00miyagawastaff000000000000Plack-1.0048# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. 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.33", "Cookie::Baker" => "0.07", "Devel::StackTrace" => "1.23", "Devel::StackTrace::AsHTML" => "0.11", "File::ShareDir" => "1.00", "Filesys::Notify::Simple" => 0, "HTTP::Entity::Parser" => "0.25", "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.15", "Try::Tiny" => 0, "URI" => "1.59", "WWW::Form::UrlEncoded" => "0.23", "parent" => 0 }, "TEST_REQUIRES" => { "Test::More" => "0.88", "Test::Requires" => 0 }, "VERSION" => "1.0048", "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.33", "Cookie::Baker" => "0.07", "Devel::StackTrace" => "1.23", "Devel::StackTrace::AsHTML" => "0.11", "File::ShareDir" => "1.00", "Filesys::Notify::Simple" => 0, "HTTP::Entity::Parser" => "0.25", "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.15", "Try::Tiny" => 0, "URI" => "1.59", "WWW::Form::UrlEncoded" => "0.23", "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); } lib000755000765000024 013761035266 13423 5ustar00miyagawastaff000000000000Plack-1.0048Plack.pm100644000765000024 1442713761035266 15203 0ustar00miyagawastaff000000000000Plack-1.0048/libpackage Plack; use strict; use warnings; use 5.008_001; our $VERSION = '1.0048'; 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 for the PSGI specification and L to know what PSGI and Plack are and why we need them. =head1 MODULES AND UTILITIES =head2 Plack::Handler L and its subclasses contains adapters for web servers. We have adapters for the built-in standalone web server L, L, L, L, L and L included in the core Plack distribution. There are also many HTTP server implementations on CPAN that have Plack handlers. See L when writing your own adapters. =head2 Plack::Loader L is a loader to load one L adapter and run a PSGI application code reference with it. =head2 Plack::Util L 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 or similar, which would be loaded (via perl's core function C) 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 directory for more examples of C<.psgi> files. =head2 plackup, Plack::Runner L is a command line launcher to run PSGI applications from command line using L 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, take a look at the L 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 gives you an easy way to wrap PSGI applications with a clean API, and compatibility with L DSL. =head2 Plack::Builder L gives you a DSL that you can enable Middleware in C<.psgi> files to wrap existent PSGI applications. =head2 Plack::Request, Plack::Response L gives you a nice wrapper API around PSGI C<$env> hash to get headers, cookies and query parameters much like L in mod_perl. L does the same to construct the response array reference. =head2 Plack::Test L is a unified interface to test your PSGI application using standard L and L pair with simple callbacks. =head2 Plack::Test::Suite L 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 or L. Forking on L is another good way if you intend to make larger fixes. See also L 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 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, L, etc.). It is recommended that you inherit from L for these types of modules. B 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 specification upon which Plack is based. L The Plack wiki: L The Plack FAQ: L =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut script000755000765000024 013761035266 14161 5ustar00miyagawastaff000000000000Plack-1.0048plackup100755000765000024 1633413761035266 15735 0ustar00miyagawastaff000000000000Plack-1.0048/script#!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 for the authoritative list. C assumes you have an C script in your current directory. The last statement of C 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 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. =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 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 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. 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 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 server implementation based on the environment variables as well as modules loaded by your application in C<%INC>. See L 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'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 environment variable. Specifies the environment option. Setting this value with C<-E> or C<--env> also writes to the C 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, C, and C. The default value is C, which causes C to load the middleware components: I, I, and I 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) is set to C. =item -r, --reload Makes plackup restart the server whenever a file in your development directory changes. This option by default watches the C 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 (default), I (automatically set when C<-r> or C<-R> is used), I, and I. See L and L 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 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 L =cut share000755000765000024 013761035266 13757 5ustar00miyagawastaff000000000000Plack-1.0048face.jpg100644000765000024 552213761035266 15523 0ustar00miyagawastaff000000000000Plack-1.0048/shareÿØÿàJFIFHHÿÛ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}á³.NFg¥6ïå¯=ªttÅÙ·;XSD¡†Ù>oz€ÓM:—bl0æ¯CùA¡kòÑ›/•j4I(‚%U¶ðÀœ}(}оüJ'+ðÖò®ÑÈ };UÛN‰S_ÿ¶5ÕÚ92*bø6Çû»þ‡ö¥Vý5û UDQÿÙbenchmarks000755000765000024 013761035266 14772 5ustar00miyagawastaff000000000000Plack-1.0048ab.pl100755000765000024 326613761035266 16063 0ustar00miyagawastaff000000000000Plack-1.0048/benchmarks#!/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); }, ); } Plack000755000765000024 013761035266 14455 5ustar00miyagawastaff000000000000Plack-1.0048/libMIME.pm100644000765000024 1733513761035266 15733 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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", ".ttf" => "font/ttf", ".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", ".webp" => "image/webp", ".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", ".xlsx" => "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet", ".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 L L =cut Test.pm100644000765000024 1130013761035266 16105 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 and L objects. It also allows you to run PSGI applications in various ways. The default backend is C, but you may also use any L 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 object and returns an C object. Use L to import shortcuts for creating requests for C, C, C, and C operations. For your convenience, the C 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 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 and a path I, instead of a path I which you might actually want. =back =head1 OPTIONS Specify the L backend using the environment variable C 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 by default) and sends live HTTP requests to test. =item ExternalServer Runs tests against an external server specified in the C environment variable instead of spawning the application in a server locally. =back For instance, test your application with the C server backend with: > env PLACK_TEST_IMPL=Server PLACK_SERVER=HTTP::Server::ServerSimple \ prove -l t/test.t =head1 AUTHOR Tatsuhiko Miyagawa =cut Util.pm100644000765000024 3672013761035266 16120 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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/($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). =item load_class my $class = Plack::Util::load_class($class [, $prefix ]); Constructs a class name and C the class. Throws an exception if the .pm file for the class is not found, just with the built-in C. 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. =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. =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) 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 file or a class name (like C) 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: 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) 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 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 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, C or C. It also has C 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_html( $string ); Entity encodes C<<>, C<< > >>, C<&>, C<"> and C<'> in the input string and returns it. =item response_cb See L for details. =back =cut fcgi.pl100755000765000024 176613761035266 16414 0ustar00miyagawastaff000000000000Plack-1.0048/benchmarks#!/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'; } Plack-Util000755000765000024 013761035266 15065 5ustar00miyagawastaff000000000000Plack-1.0048/tcan.t100644000765000024 75513761035266 16142 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; LWPish.pm100644000765000024 321013761035266 16315 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 that acts like L's request method i.e. takes HTTP::Request object and returns HTTP::Response object. This module is used solely inside L and L, and you are recommended to take a look at L if you would like to use this outside Plack. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L L L =cut Loader.pm100644000765000024 575513761035266 16375 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 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, L or L is loaded, the relevant server implementation such as L, L or L will be loaded, if they're available. =back =cut Runner.pm100644000765000024 2104313761035266 16444 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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") if -e "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; my $lib = File::Basename::dirname($psgi) . "/lib"; $self->loader->watch($lib) if -e $lib; $self->loader->watch($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 runner script. You can create your own frontend to run your application or framework, munge command line options and pass that to C method of this class. C method does exactly the same thing as the L 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. =head1 NOTES Do not directly call this module from your C<.psgi>, since that makes your PSGI application unnecessarily depend on L and won't run other backends like L or mod_psgi. If you I 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: this section used to recommend C but it's known to be broken since Plack 0.9971, since C<$0> is now I set to the .psgi file path even when you run it from plackup. =head1 SEE ALSO L =cut baybridge.jpg100644000765000024 3463613761035266 16605 0ustar00miyagawastaff000000000000Plack-1.0048/shareÿØÿàJFIFHHÿí^Photoshop 3.08BIMBZ San Francisco_ CaliforniadUSAe 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ÜÕ×,Þ[åŽ<­ä×.9,;]…Ò ++¬è=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€ðÌ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é ß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²À¤¸^#ó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ä-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ëô?:ë?…¾Š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æ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 Œ³Oe[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 !.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«ˆÍÊ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õÓJ±4‹¢RT¬†ú‚´Ê÷ª.Q[ ËY}J¬ŸW˜QU,ë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“Ì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˜TzXgstî¤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'íAã»bŠÍÈP€;* h%€T €@*@ @• @"@„Uñ@œ;`‚ÇQOø‚ƒ)>!àƒÿÙload.t100644000765000024 247513761035266 16341 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; Builder.pm100644000765000024 2052613761035266 16566 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 subclasses. The middleware you're trying to use should use L as a base class to use this DSL, inspired by Rack::Builder. Whenever you call C 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 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 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 via the C method. use Plack::Builder; my $app = builder { mount "/foo" => $app1; mount "/bar" => builder { enable "Foo"; $app2; }; }; See L's C method to see what they mean. With C you can't use C as a DSL, for the obvious reason :) B: Once you use C in your builder code, you have to use C for all the paths, including the root path (C). You can't have the default app in the last line of C 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 DSL returns a whole new PSGI application, which means =over 4 =item * C should normally the last statement of a C<.psgi> file, because the return value of C is the application that is actually executed. =item * You can nest your C blocks, mixed with C statements (see L above): builder { mount "/foo" => builder { mount "/bar" => $app; } } will locate the C<$app> under C, since the inner C block puts it under C and it results in a new PSGI application which is located under C because of the outer C block. =back =head1 CONDITIONAL MIDDLEWARE SUPPORT You can use C 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 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 L L =cut Handler.pm100644000765000024 365613761035266 16542 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 and L to various PSGI web servers, such as Apache2 for mod_perl and Standalone for L. 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 prefix, like L if you write a handler for L. 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. This is the same as C but doesn't run the main loop. =back =head1 SEE ALSO rackup =cut Request.pm100644000765000024 4530513761035266 16632 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage Plack::Request; use strict; use warnings; use 5.008_001; our $VERSION = '1.0048'; use HTTP::Headers::Fast; use Carp (); use Hash::MultiValue; use Plack::Request::Upload; use Stream::Buffered; use URI; use URI::Escape (); use Cookie::Baker (); use HTTP::Entity::Parser; use WWW::Form::UrlEncoded qw/parse_urlencoded_arrayref/; 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}; $self->env->{'plack.cookie.parsed'} = Cookie::Baker::crush_cookie($self->env->{'plack.cookie.string'}); } 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?_//; ( lc($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_parameters'}) { $self->_parse_request_body; } return $self->env->{'plack.request.body_parameters'}; } sub _query_parameters { my $self = shift; $self->env->{'plack.request.query_parameters'} ||= parse_urlencoded_arrayref($self->env->{'QUERY_STRING'}); } sub query_parameters { my $self = shift; $self->env->{'plack.request.query'} ||= Hash::MultiValue->new(@{$self->_query_parameters}); } sub body_parameters { my $self = shift; $self->env->{'plack.request.body'} ||= Hash::MultiValue->new(@{$self->_body_parameters}); } # contains body + query sub parameters { my $self = shift; $self->env->{'plack.request.merged'} ||= do { Hash::MultiValue->new( @{$self->_query_parameters}, @{$self->_body_parameters} ); }; } 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 request_body_parser { my $self = shift; $self->{request_body_parser} ||= $self->_build_body_parser; } sub _build_body_parser { my $self = shift; my $len = $self->_buffer_length_for($self->env); my $parser = HTTP::Entity::Parser->new(buffer_length => $len); $parser->register('application/x-www-form-urlencoded', 'HTTP::Entity::Parser::UrlEncoded'); $parser->register('multipart/form-data', 'HTTP::Entity::Parser::MultiPart'); $parser; } sub _buffer_length_for { my($self, $env) = @_; return $ENV{PLACK_BUFFER_LENGTH} if defined $ENV{PLACK_BUFFER_LENGTH}; if ($env->{'psgix.input.buffered'}) { return 1024 * 1024; # 1MB for buffered } else { return 1024 * 64; # 64K for unbuffered } } sub _parse_request_body { my $self = shift; my ($params,$uploads) = $self->request_body_parser->parse($self->env); $self->env->{'plack.request.body_parameters'} = $params; my $upload_hash = Hash::MultiValue->new(); while ( my ($k,$v) = splice @$uploads, 0, 2 ) { my %copy = %$v; $copy{headers} = HTTP::Headers::Fast->new(@{$v->{headers}}); $upload_hash->add($k, Plack::Request::Upload->new(%copy)); } $self->env->{'plack.request.upload'} = $upload_hash; 1; } 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 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), or see modules like L to provide higher level Request and Response API on top of PSGI. If you're looking for an easy-to-use API to convert existing CGI applications to run on PSGI, consider using L or L as well. L documentation has a good summary of using them to convert existing CGI scripts to adapt to PSGI. =head1 METHODS Some of the methods defined in the earlier versions are deprecated in version 0.99. Take a look at L. Unless otherwise noted, all methods and attributes are B, 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). =item remote_host Returns the remote host (C) of the client. It may be empty, in which case you have to get the IP address using C
method and resolve on your own. =item method Contains the request method (C, C, C, 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 want to use this to dispatch requests. =item path_info Returns B in the environment. Use this to get the local path for the requests. =item path Similar to C 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 for details. =item query_string Returns B in the environment. This is the undecoded query string in the request URI. =item script_name Returns B in the environment. This is the absolute path where your application is hosted. =item scheme Returns the scheme (C or C) of the request. =item secure Returns true or false, indicating whether the connection is secure (https). =item body, input Returns C handle. =item session Returns (optional) C hash. When it exists, you can retrieve and store per-session data from and to this hash. =item session_options Returns (optional) C hash. =item logger Returns (optional) C 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('Cookie') >> by yourself. =item query_parameters Returns a reference to a hash containing query string (GET) parameters. This hash reference is L object. =item body_parameters Returns a reference to a hash containing posted parameters in the request body (POST). As with C, the hash reference is a L object. =item parameters Returns a L 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, C, C, C, C and C. 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 but only contains up to C where your application is hosted at. Every time this method is called it returns a new, cloned URI object. =item user Returns C if it's set. =item headers Returns an L object containing the headers for the current request. =item uploads Returns a reference to a hash containing uploads. The hash reference is a L object and values are L objects. =item content_encoding Shortcut to $req->headers->content_encoding. =item content_length Returns the raw value of the Content-Length header. Before version 0.9925, this method was a shortcut for C<< $req->headers->content_length >>. =item content_type Returns the raw value of the Content-Type header. If you want just the MIME type, without any attributes like charset, use C<< $req->headers->content_type >>. See also L. Before version 0.9925, this method was a shortcut for C<< $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 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 and Hash::MultiValue instead. Unlike CGI.pm, it does I 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 object. Handy to remove dependency on L 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, C, C and C) store the hash reference as a L object. This means you can use the hash reference as a plain hash where values are B scalars (B 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 method on it, such as: my @foo = $req->query_parameters->get_all('foo'); You can also call C to always get one parameter independent of the context (unlike C), and even call C (with Hash::MultiValue 0.05 or later) to get the I 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, C and C) 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 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, request's C always gives you the action path. Note that C 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 you'll get the full URI for C. =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, C, C and C now contains L objects, rather than I which is insecure. See L 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 anymore, which means you B 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 hash reference now returns I 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 L, L =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Plack-MIME000755000765000024 013761035266 14677 5ustar00miyagawastaff000000000000Plack-1.0048/tbasic.t100644000765000024 34613761035266 16270 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-MIMEuse 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-Test000755000765000024 013761035266 15067 5ustar00miyagawastaff000000000000Plack-1.0048/t2args.t100644000765000024 47213761035266 16415 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Testuse 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; hello.t100644000765000024 75013761035266 16501 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Testuse 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; suite.t100644000765000024 72313761035266 16527 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Testuse 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; dot-psgi000755000765000024 013761035266 14776 5ustar00miyagawastaff000000000000Plack-1.0048/egecho.psgi100644000765000024 62313761035266 16721 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgimy $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 ]; }; App000755000765000024 013761035266 15175 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackFile.pm100644000765000024 1071113761035266 16572 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Apppackage 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 Response.pm100644000765000024 1422113761035266 16771 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage Plack::Response; use strict; use warnings; our $VERSION = '1.0048'; 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 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 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 is an alias. Note that this method doesn't automatically set I for the response. You have to set it manually if you want, with the C 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 header. Note that this method doesn't normalize the given URI string in the setter. See above in C 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 with everything else defaults) or a hash reference that can contain keys such as C, C, C, C, C, C, C. C can take a string or an integer (as an epoch time) and B 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 =cut Plack-Handler000755000765000024 013761035266 15525 5ustar00miyagawastaff000000000000Plack-1.0048/tcgi.t100644000765000024 203013761035266 16607 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse 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-Loader000755000765000024 013761035266 15356 5ustar00miyagawastaff000000000000Plack-1.0048/tauto.t100644000765000024 101213761035266 16645 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Loaderuse 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-Request000755000765000024 013761035266 15600 5ustar00miyagawastaff000000000000Plack-1.0048/tnew.t100644000765000024 131313761035266 16714 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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(); uri.t100644000765000024 661013761035266 16727 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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-Runner000755000765000024 013761035266 15421 5ustar00miyagawastaff000000000000Plack-1.0048/tpath.t100644000765000024 202413761035266 16700 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Runneruse 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; cookie.t100644000765000024 104113761035266 16661 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Testuse 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; Hello.pm100644000765000024 22013761035266 16600 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utilpackage Hello; sub to_app { return sub { return [200, ['Content-Type', 'text/plain'], ['Hello']]; }; } __PACKAGE__->to_app; bad.psgi100644000765000024 11213761035266 16611 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse strict; eval { load_class("CGI") }; sub { [ 200, [], ["Hello"] ] }; author-pod-syntax.t100644000765000024 45413761035266 17036 0ustar00miyagawastaff000000000000Plack-1.0048/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # 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(); Hello.psgi100644000765000024 17213761035266 17045 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgimy $handler = sub { return [ 200, [ "Content-Type" => "text/plain", "Content-Length" => 11 ], [ "Hello World" ] ]; }; error.psgi100644000765000024 20013761035266 17123 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgisub { 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"; }; image.psgi100644000765000024 43413761035266 17065 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse 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 ]; }; Component.pm100644000765000024 1022613761035266 17136 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 and C modules. If you are writing middleware, you should inherit from L, 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 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 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 and C instead. =item response_cb This is a wrapper for C in L. See L 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, C and C, and the created object persists during the web server lifecycle, unless it is running on the non-persistent environment like CGI. C 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 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 module used to inherit from L, which has been removed in favor of the L module. When developing new components it is recommended to use L like so: use Plack::Util::Accessor qw( foo bar baz ); However, in order to keep backwards compatibility this module provides a C method similar to L. New code should not use this and use L instead. =head1 SEE ALSO L L L =cut fcgi.t100644000765000024 323013761035266 16760 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse 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 lib 't/Plack-Handler'; use 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"); }; } base.t100644000765000024 253513761035266 17044 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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}; } body.t100644000765000024 65613761035266 17051 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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-Response000755000765000024 013761035266 15746 5ustar00miyagawastaff000000000000Plack-1.0048/tnew.t100644000765000024 122613761035266 17065 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse 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; bad2.psgi100644000765000024 10013761035266 16670 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utilsub load_class { die "woohaa" } sub { [ 200, [], ["Hello"] ] }; foreach.t100644000765000024 145413761035266 17025 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; xt000755000765000024 013761035266 13310 5ustar00miyagawastaff000000000000Plack-1.0048author-downstream.t100644000765000024 76113761035266 17304 0ustar00miyagawastaff000000000000Plack-1.0048/xtuse 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 Gazelle 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; Dumper.psgi100644000765000024 20713761035266 17235 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse Data::Dumper; my $handler = sub { my $env = shift; return [ 200, [ "Content-Type" => "text/plain" ], [ Dumper $env ] ]; }; cgi-pm.psgi100644000765000024 40613761035266 17156 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse 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') ] ]; }static.psgi100644000765000024 50713761035266 17273 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse 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; }; Server000755000765000024 013761035266 15450 5ustar00miyagawastaff000000000000Plack-1.0048/lib/HTTPPSGI.pm100644000765000024 2470013761035266 16733 0ustar00miyagawastaff000000000000Plack-1.0048/lib/HTTP/Serverpackage 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); use Try::Tiny; use Time::HiRes qw(time); use constant TCP_NODELAY => try { Socket::TCP_NODELAY }; 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 { ($args{listen_sock} ? ( listen_sock => $args{listen_sock}, host => $args{listen_sock}->sockhost, port => $args{listen_sock}->sockport, ):( 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; $self->{listen_sock} ||= do { my %args = ( Listen => SOMAXCONN, LocalPort => $self->{port}, LocalAddr => $self->{host}, Proto => 'tcp', ReuseAddr => 1, ); my $class = $self->prepare_socket_class(\%args); $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) { if (defined TCP_NODELAY) { $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 CGIBin.pm100644000765000024 633213761035266 16732 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Apppackage 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 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 to compile a CGI script into a sub (like L) and then run it as a persistent application using L. 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 (like C<#!/usr/bin/perl>). If yes, it is a Perl script. =back You can customize this behavior by passing C 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 L L L See also L 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 URLMap.pm100644000765000024 1302213761035266 17011 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Apppackage Plack::App::URLMap; use strict; use warnings; use parent qw(Plack::Component); use constant DEBUG => $ENV{PLACK_URLMAP_DEBUG} ? 1 : 0; 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 HTTPParser.pm100644000765000024 201513761035266 17105 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 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 to 1. =head1 SEE ALSO L L =cut Middleware.pm100644000765000024 1267013761035266 17256 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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 method (or the C 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. See L 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 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 wrapper function in L when implementing a post processing middleware. sub call { my($self, $env) = @_; # pre-processing $env my $res = $self->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 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-ish object. The application could also make use of the C<$writer> object if C 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 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 L L =cut TempBuffer.pm100644000765000024 73513761035266 17177 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plackpackage 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; Test000755000765000024 013761035266 15374 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackSuite.pm100644000765000024 5773213761035266 17221 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Testpackage 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 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 for testing, as subclassing C is for developing server implementations. =head1 AUTHOR Tokuhiro Matsuno Tatsuhiko Miyagawa Kazuho Oku =cut END_MARK_FOR_TESTING Plack-Builder000755000765000024 013761035266 15536 5ustar00miyagawastaff000000000000Plack-1.0048/tmount.t100644000765000024 46113761035266 17206 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Builderuse 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; add_type.t100644000765000024 60513761035266 16776 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-MIMEuse 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" ); Plack::MIME->add_type(".ng-html" => "text/ng-template"); is( Plack::MIME->mime_type("foo.ng-html"), "text/ng-template" ); done_testing; fallback.t100644000765000024 42713761035266 16746 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-MIMEuse 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; body.t100644000765000024 126413761035266 17233 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse 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; error.psgi100644000765000024 5013761035266 17175 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse strict; sub { $env = shift; }; hello.psgi100644000765000024 10113761035266 17164 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utilsub { return [200, ['Content-Type', 'text/plain'], ['Hello']] }; slowapp.psgi100644000765000024 114113761035266 17504 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgi# 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" ] ]; }; Message000755000765000024 013761035266 15566 5ustar00miyagawastaff000000000000Plack-1.0048/lib/HTTPPSGI.pm100644000765000024 1515013761035266 17050 0ustar00miyagawastaff000000000000Plack-1.0048/lib/HTTP/Messagepackage 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) { $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 Cascade.pm100644000765000024 525613761035266 17226 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Apppackage 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 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 Rack::Cascade =cut PSGIBin.pm100644000765000024 266113761035266 17073 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Apppackage 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 WrapCGI.pm100644000765000024 742613761035266 17140 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Apppackage 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 ); local $SIG{CHLD} = 'DEFAULT'; 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 = ''; my $waited_pid; while (($waited_pid = waitpid($pid, WNOHANG)) == 0) { $res .= slurp_fh($stdoutr); } $res .= slurp_fh($stdoutr); # -1 means that the child went away, and something else # (probably some global SIGCHLD handler) took care of it; # yes, we just reset $SIG{CHLD} above, but you can never # be too sure if (POSIX::WIFEXITED($?) || $waited_pid == -1) { 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 Handler000755000765000024 013761035266 16032 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackCGI.pm100644000765000024 1313513761035266 17155 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handlerpackage 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) 103 => 'Early Hints', 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 =cut Server.pm100644000765000024 301013761035266 17332 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Testpackage 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 $host = $args{host} || '127.0.0.1'; my $server = Test::TCP->new( listen => $args{listen}, host => $host, code => sub { my $sock_or_port = shift; my $server = Plack::Loader->auto( ($args{listen} ? ( listen_sock => $sock_or_port, ):( port => $sock_or_port, host => $host, )) ); $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 how to use this module. =head1 AUTHOR Tatsuhiko Miyagawa Tokuhiro Matsuno =head1 SEE ALSO L L L =cut delayed.t100644000765000024 66013761035266 17274 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Loaderuse 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; shotgun.t100644000765000024 72713761035266 17360 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Loaderuse 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(); cookie.t100644000765000024 270113761035266 17376 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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)"; is $req->cookies->{ZZZ}, 'spaced out'; is $req->cookies->{ZZTOP}, '"with quotes"'; is $req->cookies->{BOTH}, '"internal quotes"'; is $req->cookies->{EMPTYQUOTE}, ''; is $req->cookies->{EMPTY}, ''; is $req->cookies->{BADSTART}, '"data'; is $req->cookies->{BADEND}, 'data"'; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; my $req = HTTP::Request->new(GET => "/"); $req->header(Cookie => join(' ', 'Foo=Bar;', 'Bar=Baz;', 'XXX=Foo%20Bar;', 'YYY=0;', 'YYY=3;', 'ZZZ="spaced out";', 'ZZTOP=%22with%20quotes%22;', 'BOTH="%22internal quotes%22";', 'EMPTYQUOTE="";', 'EMPTY=;', 'BADSTART="data;', 'BADEND=data"', )); $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 => "/")); }; done_testing; foo1.txt100644000765000024 413761035266 17257 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestfoo foo2.txt100644000765000024 413761035266 17260 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestfoo params.t100644000765000024 170613761035266 17414 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; upload.t100644000765000024 270713761035266 17417 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; options.t100644000765000024 271213761035266 17443 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Runneruse 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; runnable.psgi100755000765000024 33513761035266 17614 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgi#!/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" ] ]; }; FCGI.pm100644000765000024 3355313761035266 17271 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handlerpackage 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, 'psgix.cleanup' => 1, 'psgix.cleanup.handlers' => [], }; 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(); # When the fcgi-manager exits it sends a TERM signal to the workers. # However, if we're busy processing the cleanup handlers, testing # shows that the worker doesn't actually exit in that case. # Trapping the TERM signal and finshing up fixes that. my $exit_due_to_signal = 0; if ( @{ $env->{'psgix.cleanup.handlers'} || [] } ) { local $SIG{TERM} = sub { $exit_due_to_signal = 1 }; for my $handler ( @{ $env->{'psgix.cleanup.handlers'} } ) { $handler->($env); } } if ($proc_manager && $env->{'psgix.harakiri.commit'}) { $proc_manager->pm_exit("safe exit with harakiri"); } elsif ($exit_due_to_signal) { $proc_manager && $proc_manager->pm_exit("safe exit due to signal"); exit; # want to exit, even without a $proc_manager } } } 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, "+&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, defaults to 100. =back =head2 EXTENSIONS Supported L. =over 4 =item psgix.cleanup push @{ $env->{'psgix.cleanup.handlers'} }, sub { warn "Did this later" } if $env->{'psgix.cleanup'}; Supports the C extension, in order to use it, just push a callback onto C<< $env->{'psgix.cleanup.handlers' >>. These callbacks are run after the C hook. =item psgix.harakiri $env->{'psgix.harakiri.commit'} = 1 if $env->{'psgix.harakiri'}; If there is a L, then C will be enabled and setting C<< $env->{'psgix.harakiri.commit'} >> to a true value will cause C<< $manager->pm_exit >> to be called after the request is finished. =back =head2 WEB SERVER CONFIGURATIONS In all cases, you will want to install L and L. You may find it most convenient to simply install L 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 and the rest of the path in C. See L for more details. =head3 Apache mod_fastcgi After installing C, you should add the C 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 (with regards to Catalyst, but which may be set up similarly for Plack). See also L 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 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, mounting apps under the root causes wrong C and C 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. In such cases you can use L 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 have the trailing slash. If you I need to have one, you should consider using L to fix the wrong B values set by lighttpd. =cut =head2 Authorization Most fastcgi configuration does not pass C headers to C environment variable by default for security reasons. Authentication middleware such as L or L requires the variable to be set up. Plack::Handler::FCGI supports extracting the C environment variable when it is configured that way. Apache2 with mod_fastcgi: --pass-header Authorization mod_fcgid: FcgidPassHeader Authorization =head2 Server::Starter This plack handler supports L 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 =cut HTTP-Server-PSGI000755000765000024 013761035266 15703 5ustar00miyagawastaff000000000000Plack-1.0048/tpost.t100644000765000024 275613761035266 17227 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Server-PSGIuse strict; use warnings; use Plack::Loader; use Test::More; use Test::TCP; use Test::Requires qw(LWP::UserAgent); test_tcp( listen => 1, server => sub { my $socket = shift; my $server = Plack::Loader->auto(listen_sock => $socket); $server->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; builder.t100644000765000024 26713761035266 17476 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Builderuse strict; use Test::More tests => 1; use Plack::Builder; my $app = builder { mount "/" => sub { [ 200, ["Content-Type", "text/plain"], ["Hello"] ] }; }; is ref($app), 'CODE'; apache1.t100644000765000024 334213761035266 17356 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse 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 SetHandler perl-script PerlHandler Plack::Handler::Apache1 PerlSetVar psgi_app $tmpdir/app.psgi END return $conf; } apache2.t100644000765000024 551413761035266 17362 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse 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 use Plack::Handler::Apache2; Plack::Handler::Apache2->preload("$tmpdir/app.psgi"); SetHandler perl-script PerlHandler Plack::Handler::Apache2 PerlSetVar psgi_app $tmpdir/app.psgi 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 use Plack::Handler::Apache2; Plack::Handler::Apache2->preload("$tmpdir/app.psgi"); SetHandler perl-script PerlHandler Plack::Handler::Apache2 PerlSetVar psgi_app $tmpdir/app.psgi 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 use Plack::Handler::Apache2; Plack::Handler::Apache2->preload("$tmpdir/app.psgi"); SetHandler perl-script PerlHandler Plack::Handler::Apache2 PerlSetVar psgi_app $tmpdir/app.psgi END } Plack-Middleware000755000765000024 013761035266 16225 5ustar00miyagawastaff000000000000Plack-1.0048/tfile.t100644000765000024 240213761035266 17467 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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/; $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; head.t100644000765000024 77613761035266 17445 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; lint.t100644000765000024 345213761035266 17524 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; content.t100644000765000024 122513761035266 17577 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; headers.t100644000765000024 122713761035266 17542 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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); return [200, ['Content-Type', 'text/plain'], [ $req->headers->as_string ]]; }; my $test = Plack::Test->create($app); my $res = $test->request(GET '/', 'Foo' => 1, 'foo-bar' => 1, 'www-authenticate' => 'basic bar'); like $res->content, qr/Foo: 1/, 'no uppercase'; like $res->content, qr/Foo-Bar: 1/, 'standard casing'; like $res->content, qr/Host: localhost/, 'standard casing'; like $res->content, qr/WWW-Authenticate: basic bar/, 'standard casing'; done_testing; cookie.t100644000765000024 152313761035266 17545 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse 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; to_app.t100644000765000024 53513761035266 17540 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse 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; header_get.t100644000765000024 121713761035266 17502 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; header_set.t100644000765000024 154213761035266 17517 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; is_real_fh.t100644000765000024 72213761035266 17466 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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-req.psgi100644000765000024 40013761035266 17653 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse 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; } static000755000765000024 013761035266 16265 5ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgitest.js100644000765000024 2113761035266 17673 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgi/staticfunction foo() {}Directory.pm100644000765000024 623713761035266 17647 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Apppackage 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 = "%s%s%s%s"; my $dir_page = < %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) = @_; if (-f $dir) { return $self->SUPER::serve_path($env, $dir); } 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 HTTPParser000755000765000024 013761035266 16411 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackPP.pm100644000765000024 461513761035266 17434 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/HTTPParserpackage 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 instead. =head1 AUTHOR Tatsuhiko Miyagawa =cut MockHTTP.pm100644000765000024 203213761035266 17460 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Testpackage 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 how to use this module. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L =cut Util000755000765000024 013761035266 15372 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackAccessor.pm100644000765000024 165413761035266 17640 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Utilpackage 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 L =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut HTTP-Message-PSGI000755000765000024 013761035266 16021 5ustar00miyagawastaff000000000000Plack-1.0048/thost.t100644000765000024 123513761035266 17324 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Message-PSGIuse 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; restarter.t100644000765000024 321713761035266 17721 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Loaderuse 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 3; wait_port($port); is $cb->()->content, $return_bodies[1]; touch($restartertestfiles[1]); sleep 3; wait_port($port); is $cb->()->content, $return_bodies[2]; }, listen => 1, server => sub { my $socket = shift; my $loader = Plack::Loader::Restarter->new; my $server = $loader->auto(listen_sock => $socket); $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; jsonp.t100644000765000024 261213761035266 17704 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; order.t100644000765000024 60713761035266 17650 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; hostname.t100644000765000024 50013761035266 17716 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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"; readbody.t100644000765000024 70613761035266 17701 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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/; } } uri_utf8.t100644000765000024 51213761035266 17650 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; headers.t100644000765000024 73413761035266 17672 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse strict; use warnings; use Test::More; use Plack::Response; use Test::Requires qw( HTTP::Headers ); my $hdrs = HTTP::Headers->new; $hdrs->header('Content-Type' => 'text/plain'); { my $res = Plack::Response->new(200, $hdrs, []); is_deeply $res->finalize, [200, ['Content-Type' => 'text/plain'], []]; } { my $res = Plack::Response->new(200); $res->headers($hdrs); is_deeply $res->finalize, [200, ['Content-Type' => 'text/plain'], []]; } done_testing; Plack-TempBuffer000755000765000024 013761035266 16207 5ustar00miyagawastaff000000000000Plack-1.0048/tprint.t100644000765000024 164613761035266 17677 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-TempBufferuse 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; header_push.t100644000765000024 114113761035266 17676 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; headers_obj.t100644000765000024 106113761035266 17655 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; response_cb.t100644000765000024 135113761035266 17714 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; cgi-script.psgi100644000765000024 24313761035266 20045 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse CGI::Emulate::PSGI; my $handler = CGI::Emulate::PSGI->handler(sub { do "hello.cgi"; CGI::initialize_globals() if defined &CGI::initialize_globals; }); test.css100644000765000024 3113761035266 20050 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgi/staticbody { font-size: 20px } Loader000755000765000024 013761035266 15663 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackDelayed.pm100644000765000024 306413761035266 17733 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Loaderpackage 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, 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 is loaded per children. L since version 0.2000 loads this loader by default unless you specify the command line option C<--preload-app> for the L executable. =head1 DEVELOPERS Web server developers can make use of C attribute callback set in Plack::Handler, to load the application earlier than the first request time. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L =cut Shotgun.pm100644000765000024 546713761035266 20024 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Loaderpackage Plack::Loader::Shotgun; use strict; use parent qw(Plack::Loader); use Storable; use Try::Tiny; use Plack::Middleware::BufferedStreaming; die <{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 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 =head1 SEE ALSO L =cut Request000755000765000024 013761035266 16105 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackUpload.pm100644000765000024 316013761035266 20027 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Requestpackage 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, L =cut listen.t100644000765000024 147113761035266 17531 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Server-PSGIuse strict; use warnings; use HTTP::Server::PSGI; use Test::More; use Test::TCP; use Test::Requires qw(LWP::UserAgent); my $ua_timeout = 3; test_tcp( listen => 1, server => sub { my $socket = shift; my $server = HTTP::Server::PSGI->new( listen_sock => $socket, ); $server->run( sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hi" ], ]; }, ); }, client => sub { my $port = shift; my $ua = LWP::UserAgent->new; my $res = $ua->get("http://127.0.0.1:$port/"); ok $res->is_success; is $res->code, 200; is $res->content, 'Hi'; }, ); done_testing; cgibin.t100644000765000024 333313761035266 20007 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; htpasswd100644000765000024 2413761035266 20101 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareadmin:6iSeSVcVHgNQw prefix.t100644000765000024 56413761035266 20034 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; static.t100644000765000024 540113761035266 20041 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; urlmap.t100644000765000024 331213761035266 20051 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; path_info.t100644000765000024 137513761035266 20102 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; redirect.t100644000765000024 134713761035266 20101 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse 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; response.t100644000765000024 231313761035266 20130 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse 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; hello_server.t100644000765000024 102713761035266 20105 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Testuse 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; inc000755000765000024 013761035266 15636 5ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utilhello.psgi100644000765000024 3513761035266 17723 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Util/incdie "Do not load this file"; io_with_path.t100644000765000024 36013761035266 20047 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; echo-stream.psgi100644000765000024 73613761035266 20217 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse 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"); }; }; }; Apache1.pm100644000765000024 775713761035266 20012 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handlerpackage 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 SetHandler perl-script PerlHandler Plack::Handler::Apache1 PerlSetVar psgi_app /path/to/app.psgi use Plack::Handler::Apache1; Plack::Handler::Apache1->preload("/path/to/app.psgi"); =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 Apache instead of using mod_perl, see L to run with FastCGI, or use standalone HTTP servers such as L or L proxied with mod_proxy. =head1 AUTHOR Aaron Trevena Tatsuhiko Miyagawa =head1 SEE ALSO L =cut Apache2.pm100644000765000024 2414313761035266 20017 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handlerpackage 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 or 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 '/') { # 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 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 SetHandler perl-script PerlResponseHandler Plack::Handler::Apache2 PerlSetVar psgi_app /path/to/app.psgi # Optionally preload your apps in startup PerlPostConfigRequire /etc/httpd/startup.pl See L for more details on writing a C. =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 Apache instead of using mod_perl, see L to run with FastCGI, or use standalone HTTP servers such as L or L 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 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 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 for general information on the C 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 is C<< > 1 >>, otherwise your app will load twice and the env vars you set with L will not be available when your app is loading the first time. Use the example above as a template. =item * C<@INC> The C file is a good place to add entries to your C<@INC>. Use L to add entries, they can be in your app or C<.psgi> as well, but if your modules are in a L 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, which will also work. =item * loading errors Any exceptions thrown in your C 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 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. 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. 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 =cut Middleware000755000765000024 013761035266 16532 5ustar00miyagawastaff000000000000Plack-1.0048/lib/PlackHead.pm100644000765000024 135113761035266 20071 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 Lint.pm100644000765000024 1611313761035266 20160 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage Plack::Middleware::Lint; use strict; no warnings; use Carp (); use parent qw(Plack::Middleware); use Scalar::Util qw(blessed reftype); use Plack::Util; sub wrap { my($self, $app) = @_; unless (reftype $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 _. Header: $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. Header: $key"); } if ($val =~ /[\000-\037]/) { die("Response headers MUST NOT contain characters below octal \037. Header: $key. Value: $val"); } unless (defined $val) { die("Response headers MUST be a defined string. Header: $key"); } } # @$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 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 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 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 =cut FCGIUtils.pm100644000765000024 472513761035266 17764 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handlerpackage 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; standalone.t100644000765000024 21013761035266 20153 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse strict; use warnings; use Test::More; use Plack::Test::Suite; Plack::Test::Suite->run_server_tests('Standalone'); done_testing(); chunked.t100644000765000024 310013761035266 20165 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; psgibin.t100644000765000024 56213761035266 20170 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; runtime.t100644000765000024 66413761035266 20223 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; wrapcgi.t100644000765000024 170113761035266 20205 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; multi_read.t100644000765000024 76413761035266 20241 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; parameters.t100644000765000024 77013761035266 20254 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; header_exists.t100644000765000024 173613761035266 20250 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; header_remove.t100644000765000024 237513761035266 20226 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; inline_object.t100644000765000024 101213761035266 20210 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utiluse 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; index.html100644000765000024 23113761035266 20376 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgi/static Hello Restarter.pm100644000765000024 503013761035266 20332 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Loaderpackage 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 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, L =cut JSONP.pm100644000765000024 344713761035266 20131 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 or C as a JSONP response which is specified with the C 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 =cut harakiri.t100644000765000024 233713761035266 20027 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Server-PSGIuse strict; use warnings; use Plack::Loader; use Test::More; use Test::TCP; use Test::Requires qw(LWP::UserAgent); my $ua_timeout = 3; test_tcp( listen => 1, server => sub { my $socket = shift; my $server = Plack::Loader->auto(listen_sock => $socket); $server->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; try_mangle.pl100644000765000024 34113761035266 20341 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse 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; lint_env.t100644000765000024 225513761035266 20374 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; log4perl.t100644000765000024 203313761035266 20300 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; static.foo100644000765000024 413761035266 20273 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewarebar static.txt100644000765000024 413761035266 20327 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewarefoo double_port.t100644000765000024 65113761035266 20425 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; many_upload.t100644000765000024 354413761035266 20443 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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>; } request_uri.t100644000765000024 70413761035266 20455 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; compatible.t100644000765000024 214613761035266 20415 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Responseuse 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; bin000755000765000024 013761035266 15635 5ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Utilfindbin.psgi100644000765000024 12513761035266 20250 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Util/binuse FindBin; sub { [ 200, [ "Content-Type", "text/plain" ], [ "$FindBin::Bin" ] ] }; Static.pm100644000765000024 1040213761035266 20474 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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, you should consider using L 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 option to change this behavior. If the requested document is not within the C 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 or using C. =head1 CONFIGURATIONS =over 4 =item path, root enable "Plack::Middleware::Static", path => qr{^/static/}, root => 'htdocs/'; The C option specifies the URL pattern (regular expression) or a callback to match against requests. If the option matches, the middleware looks in C to find the static files to serve. The default value of C is the current directory. This example configuration serves C from C. Note that the matched portion of the path, C, still appears in the locally mapped path under C. 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. The configuration above serves C from C, not C. The callback specified in the C option matches against C<$_> munges this value using C. 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 callback, in addition to C<$_> being set the callback receives two arguments, C (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 option can be used to provide access to a different MIME database than L. L 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 or L 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 L =cut utf8_req.t100644000765000024 105113761035266 20100 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Message-PSGIuse 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; oo_interface.t100644000765000024 407613761035266 20527 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Builderuse 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-HTTPParser-PP000755000765000024 013761035266 16421 5ustar00miyagawastaff000000000000Plack-1.0048/tsimple.t100644000765000024 532213761035266 20241 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-HTTPParser-PPuse 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; fcgi_cleanup.t100644000765000024 1101613761035266 20510 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse strict; use warnings; use Test::More; plan skip_all => "release test only" unless $ENV{RELEASE_TESTING}; use Test::Requires qw(FCGI FCGI::ProcManager LWP::UserAgent); use Plack; use Plack::Util; use Plack::Handler::FCGI; use Test::TCP; use lib 't/Plack-Handler'; use FCGIUtils; my $ua_timeout = 3; test_lighty_external( sub { my ($lighty_port, $fcgi_port, $needs_fix) = @_; test_tcp( port => $fcgi_port, server => sub { my ($port) = @_; my %c = run_server_cb($needs_fix)->($port); ok $c{enabled}, "Cleanup extension is enabled"; ok $c{before}{enabled}, "> was enabled before"; ok $c{response_cb}{enabled}, "> still enabled in response_cb"; ok $c{before}{handler_set_up}, "Handler was an arrayref before"; ok $c{handled}, "Cleanup handler ran successfully"; ok !$c{before}{ran}, "> had not run before"; ok !$c{response_cb}{ran}, "> had not run in response_cb"; ok $c{before}{handled}, "Ran handler set up before"; ok $c{response_cb}{handled}, "Ran handler set up in response_cb"; ok !$c{before}{handler_count}, "No handlers before"; is $c{response_cb}{handler_count}, 2, "One handler entered response_cb"; ok $c{response_cb}{handled} - $c{before}{handled} >= 3, "Before handler at least three seconds before response_cb"; }, client => sub { # my ($port) = @_; Need to use the $lighty_port my $ua = LWP::UserAgent->new( timeout => $ua_timeout ); my $res = $ua->get("http://127.0.0.1:$lighty_port/"); my $response_received = time; ok $res->is_success, "Got successful response"; my ($handled, $response_sent) = split /:/, $res->content; is $handled, '0', "With response indicating not yet cleaned up"; ok $response_received - $response_sent <= 1, "Response received within a second of being sent"; # have to make the client wait until the server has exited # otherwise the FCGI gets confused by sending a TERM # that doesn't get handled right away. sleep 5; }, ); } ); done_testing(); sub run_server_cb { my $needs_fix = shift; require Plack::Middleware::LighttpdScriptNameFix; return sub { my ($port) = @_; my %r = ( handled => 0 ); # An app inside an faux middleware my $app = sub { my ($env) = @_; local $SIG{TERM} = sub { diag "app (pid $$) received signal TERM\n"; $env->{'psgix.harakiri.commit'} = 1; push @{ $env->{'psgix.cleanup.handlers'} }, sub {exit}; }; $r{before} = { enabled => $env->{'psgix.cleanup'}, ran => $r{handled}, handler_count => scalar @{ $env->{'psgix.cleanup.handlers'} }, handler_set_up => ref $env->{'psgix.cleanup.handlers'} eq 'ARRAY', }; push @{ $env->{'psgix.cleanup.handlers'} }, sub { $r{before}{handled} = time }; # The app my $res = sub { my ($env) = @_; $r{enabled} = $env->{'psgix.cleanup'}; push @{ $env->{'psgix.cleanup.handlers'} }, sub { sleep 3; $r{handled} = time }; # Use streaming response to verify that cleanup happens # even after that. sub { shift->( [ 200, [], [ $r{handled} . ':' . time ] ] ) } }->($env); Plack::Util::response_cb( $res, sub { $r{response_cb} = { enabled => $env->{'psgix.cleanup'}, ran => $r{handled}, handler_count => scalar @{ $env->{'psgix.cleanup.handlers'} }, }; push @{ $env->{'psgix.cleanup.handlers'} }, sub { $r{response_cb}{handled} = time }; } ); }; if ($needs_fix) { note "Applying LighttpdScriptNameFix"; $app = Plack::Middleware::LighttpdScriptNameFix->wrap($app); } $| = 0; # Test::Builder autoflushes this. reset! Plack::Handler::FCGI->new( host => '127.0.0.1', port => $port, keep_stderr => 1, )->run($app); return %r; }; } auto_fallback.t100644000765000024 64413761035266 20456 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Loaderuse 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; component.t100644000765000024 304713761035266 20560 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; directory.t100644000765000024 247013761035266 20561 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; open my $fh, ">", "share/#foo" or die $!; close $fh; # 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 \//; unlink "share/#foo"; 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; xsendfile.t100644000765000024 214613761035266 20536 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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', 'Content-Length' => 1234; 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, ''; is $res->header('Content-Length'), 0, 'Content-Length 0'; } }; 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; query_string.t100644000765000024 66413761035266 20646 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; upload-large.t100644000765000024 134613761035266 20505 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; nonblock-hello.psgi100644000765000024 76313761035266 20716 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse 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; }; }; }; twitter-stream.psgi100644000765000024 127413761035266 21021 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgiuse 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"); }; }; }; Standalone.pm100644000765000024 104513761035266 20620 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handlerpackage 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. This is just an alias for L. =head1 SEE ALSO L =cut Chunked.pm100644000765000024 270713761035266 20617 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 implementations $app = Plack::Middleware::Chunked->wrap($app); =head1 DESCRIPTION Plack::Middleware::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 Refresh.pm100644000765000024 305113761035266 20625 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 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 seconds which defaults to 10, call L 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, take a look at L's default -r option or L instead. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L Rack::Reloader =cut Runtime.pm100644000765000024 200613761035266 20651 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 HTTP response header. =head1 OPTIONS =over 4 =item header_name Name of the header. Defaults to I. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L Rack::Runtime =cut path_info.t100644000765000024 101313761035266 20310 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Message-PSGIuse 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; access_log.t100644000765000024 463113761035266 20660 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; auth_basic.t100644000765000024 162313761035266 20656 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; static_env.t100644000765000024 142713761035266 20715 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; urlmap_env.t100644000765000024 140313761035266 20720 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; xframework.t100644000765000024 46213761035266 20721 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; Log4perl.pm100644000765000024 406713761035266 20727 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 component that allows you to use L to configure the logging object C for a given category. =head1 CONFIGURATION =over 4 =item category The C 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 to automatically configure. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L L =cut restarter_valid.t100644000765000024 117213761035266 21076 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Loaderuse 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 myapp.git/some-file ); 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; cgibin_exec.t100644000765000024 332213761035266 21011 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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"; } 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; conditional.t100644000765000024 165313761035266 21062 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; content-on-get.t100644000765000024 67713761035266 20760 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; echo-stream-sync.psgi100644000765000024 41713761035266 21165 0ustar00miyagawastaff000000000000Plack-1.0048/eg/dot-psgimy $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"); } }; }; AccessLog.pm100644000765000024 1402013761035266 21110 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 or C for the default formats). If none is specified C 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 the response is actually sent to the client. Use L if you want to log details B the response is transmitted (more like a real web server) to the client. This middleware is enabled by default when you run L as a default C 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 or C) to specify the log format. This middleware uses L to generate access_log lines. See more details on perldoc L %% 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. In addition, custom values can be referenced, using C<%{name}>, with one of the mandatory modifier flags C, C or C: %{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 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's C. For more details see L. =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's C. For more details see L. =back =head1 AUTHORS Tatsuhiko Miyagawa Masahiro Nagano =head1 SEE ALSO L, L Rack::CustomLogger =cut Recursive.pm100644000765000024 674013761035266 21206 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 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 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 or L, be sure to wrap this so L gets as inner as possible. =head1 AUTHORS Tatsuhiko Miyagawa Masahiro Honma =head1 SEE ALSO L L The idea, code and interface are stolen from Rack::Recursive and paste.recursive. =cut XSendfile.pm100644000765000024 564713761035266 21125 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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; $h->set('Content-Length', 0); $body = []; } elsif ($type eq 'X-Sendfile' or $type eq 'X-Lighttpd-Send-File') { my $path = $body->path; $h->set($type => $path) if defined $path; $h->set('Content-Length', 0); $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 When the body is a blessed reference with a C method, then the return value of that method is used to set the X-Sendfile header. The body is set to an empty list, and the Content-Length header is set to 0. If the X-Sendfile header is already set, then the body and Content-Length will be untouched. You should use L or L's C to add C method to an IO object in the body. See L for the frontend configuration. Plack::Middleware::XSendfile does not set the Content-Type header. =head1 CONFIGURATION =over 4 =item variation The header tag to use. If unset, the environment key C will be used, then the C header. Supported values are: =over =item * C =item * C =item * C. =back An unsupport value will log an error. =back =head1 AUTHOR Tatsuhiko Miyagawa =cut output_encoding.t100644000765000024 135413761035266 21263 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse 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; } log_dispatch.t100644000765000024 231213761035266 21210 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; refresh-init.t100644000765000024 216713761035266 21157 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; urlmap_ports.t100644000765000024 135413761035266 21304 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; wrapcgi_exec.t100644000765000024 1021013761035266 21224 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; }; # test that SIGCHLD handlers don't interfere { my $tmp = File::Temp->new(CLEANUP => 1); print $tmp <<"..."; #!$^X use CGI; my \$q = CGI->new; print \$q->header, "Hello"; ... close $tmp; chmod(oct("0700"), $tmp->filename) or die "Cannot chmod"; local $SIG{CHLD} = 'IGNORE'; 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, "Hello"; }; undef $tmp; }; done_testing; body-unbuffered.t100644000765000024 132213761035266 21203 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse strict; use warnings; use Test::More; use Plack::Test; use Plack::Request; use Plack::Util; use HTTP::Request::Common; my $app = sub { my $env = shift; $env->{'psgix.input.buffered'} = 0; my $input = $env->{'psgi.input'}; $env->{'psgi.input'} = Plack::Util::inline_object read => sub { $input->read(@_) }; my $req = Plack::Request->new($env); is $req->content, '{}'; $req->new_response(200)->finalize; }; test_psgi $app, sub { my $cb = shift; # empty Content-Type my $req = POST "/"; $req->content_type(""); $req->content("{}"); $req->content_length(2); my $res = $cb->($req); ok $res->is_success or diag $res->as_string; }; done_testing; upload-basename.t100644000765000024 31213761035266 21136 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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'; Auth000755000765000024 013761035266 17433 5ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/MiddlewareBasic.pm100644000765000024 665113761035266 21162 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middleware/Authpackage 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 method that takes username and password and returns boolean, so backends for L 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. =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 or L. 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 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 =cut ContentMD5.pm100644000765000024 220413761035266 21146 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 NullLogger.pm100644000765000024 102713761035266 21302 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 StackTrace.pm100644000765000024 1507013761035266 21277 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 <[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 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 and C respectively, so that middleware further up the stack can reference it. This middleware is enabled by default when you run L in the default I mode. You're recommended to use this middleware during the development and use L 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 module will be used to capture the stack trace if the installed version is 0.08 or later. Otherwise L is used. =head2 Performance Gathering the information for a stack trace via L is slow, and L 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 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 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). 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 L L =cut XFramework.pm100644000765000024 157313761035266 21323 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 header to the HTTP response. =head1 CONFIGURATION =over 4 =item framework Sets the string value of C header. If not set, the header is not set to the response. =back =head1 SEE ALSO L =cut apache2-registry.t100644000765000024 523113761035266 21224 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Handleruse 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; SetHandler modperl PerlHandler Plack::Handler::Apache2::Registry END } cascade000755000765000024 013761035266 17610 5ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewarebasic.t100644000765000024 145713761035266 21225 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/cascadeuse 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; errors000755000765000024 013761035266 17541 5ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware404.html100644000765000024 4113761035266 21031 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/errorsa b c This is a fancy 404 page. 500.html100644000765000024 3213761035266 21026 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/errorsThis is a fancy 500 page! simple_logger.t100644000765000024 124613761035266 21405 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; Conditional.pm100644000765000024 414613761035266 21500 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 should come first because the conditional check runs in I 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 =cut LogDispatch.pm100644000765000024 304413761035266 21432 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 component that allows you to use L to configure the logging object, C. =head1 CONFIGURATION =over 4 =item logger L object to send logs to. Required. =back =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L L =cut auth_basic_env.t100644000765000024 270013761035266 21523 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; cgi-bin000755000765000024 013761035266 17535 5ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewarehello.py100755000765000024 34513761035266 21337 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/cgi-bin#!/usr/bin/python from __future__ import print_function import os print("Content-Type: text/plain") print for item in ([ "foo", "bar" ]): print("Hello " + item + ". ") print("QUERY_STRING is " + os.environ['QUERY_STRING']) utf8.cgi100755000765000024 15213761035266 21230 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/cgi-bin#!perl use CGI; binmode STDOUT, ":utf8"; print CGI::header("text/html;charset=utf-8"), chr(4343), "\n"; component-leak.t100644000765000024 242113761035266 21465 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewarepackage 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; conditionalget.t100644000765000024 615713761035266 21566 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse strict; use warnings; use Plack::Builder; use Test::More; my $tag = "Foo"; my $date = "Wed, 23 Sep 2009 13:36:33 GMT"; my $non_matching_date = "Wed, 23 Sep 2009 13:36:32 GMT"; 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' => $tag, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_NONE_MATCH => $tag }, status => 304, headers => [ ETag => $tag ], }, { app => sub { [ 200, [ 'Last-Modified' => $date, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_MODIFIED_SINCE => $date }, status => 304, headers => [ "Last-Modified" => $date ], }, { app => sub { [ 200, [ 'Last-Modified' => $date, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_MODIFIED_SINCE => $non_matching_date }, status => 200, headers => [ "Last-Modified", $date, "Content-Type", "text/plain", ], }, { app => sub { [ 200, [ 'Last-Modified' => $date, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_MODIFIED_SINCE => "$date; length=2" }, status => 304, headers => [ "Last-Modified", $date ], }, { app => sub { [ 200, [ 'ETag' => $tag, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "POST", HTTP_IF_NONE_MATCH => $tag }, status => 200, headers => [ ETag => $tag, 'Content-Type' => "text/plain" ], }, { app => sub { [ 200, [ 'ETag' => $tag, 'Last-Modified' => $date, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_NONE_MATCH => $tag, HTTP_IF_MODIFIED_SINCE => $date }, status => 304, headers => [ ETag => $tag, 'Last-Modified' => $date ], }, { app => sub { [ 200, [ 'ETag' => $tag, 'Last-Modified' => $date, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_NONE_MATCH => "Bar", HTTP_IF_MODIFIED_SINCE => $date }, status => 200, headers => [ ETag => $tag, 'Last-Modified' => $date, 'Content-Type' => 'text/plain' ], }, { app => sub { [ 200, [ 'ETag' => $tag, 'Last-Modified' => $date, 'Content-Type' => 'text/plain' ], [ 'OK' ] ] }, env => { REQUEST_METHOD => "GET", HTTP_IF_NONE_MATCH => $tag, HTTP_IF_MODIFIED_SINCE => $non_matching_date }, status => 200, headers => [ ETag => $tag, 'Last-Modified' => $date, '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}; } content_length.t100644000765000024 277513761035266 21600 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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}; }; error_document.t100644000765000024 213313761035266 21600 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; head_streaming.t100644000765000024 107013761035266 21522 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; httpexceptions.t100644000765000024 277713761035266 21650 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; recursive000755000765000024 013761035266 20234 5ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewarebase.t100644000765000024 117113761035266 21473 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/recursiveuse 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; urlmap_builder.t100644000765000024 303713761035266 21563 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; path_info_escaped.t100644000765000024 163113761035266 21561 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Requestuse 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; SimpleLogger.pm100644000765000024 337413761035266 21630 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 stream, which is mostly STDERR or server log output. =head1 SEE ALSO L, essentially the opposite of this module =head1 AUTHOR Tatsuhiko Miyagawa =cut content_length.t100644000765000024 60313761035266 21340 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Message-PSGIuse 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; hello.cgi100755000765000024 17213761035266 21447 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/cgi-bin#!/usr/bin/perl use CGI; my $q = CGI->new; print $q->header, "Hello ", scalar $q->param('name'), " counter=", ++$COUNTER; conditional_new.t100644000765000024 225413761035266 21731 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; throw.t100644000765000024 162713761035266 21732 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/recursiveuse 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; stacktrace000755000765000024 013761035266 20351 5ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareutf8.t100644000765000024 122713761035266 21566 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/stacktraceuse 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; Apache2000755000765000024 013761035266 17275 5ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/HandlerRegistry.pm100644000765000024 221413761035266 21602 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handler/Apache2package 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; SetHandler modperl PerlHandler Plack::Handler::Apache2::Registry =head1 DESCRIPTION This is a handler module to run any *.psgi files with mod_perl2, just like ModPerl::Registry. =head1 AUTHOR Masahiro Honma Ehiratara@cpan.orgE =head1 SEE ALSO L =cut Server000755000765000024 013761035266 20057 5ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handler/HTTPPSGI.pm100644000765000024 222113761035266 21314 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Handler/HTTP/Serverpackage 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 or L 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 L =cut ContentLength.pm100644000765000024 257113761035266 22011 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 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 rather than in the end user level. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO Rack::ContentLength =cut ErrorDocument.pm100644000765000024 742513761035266 22030 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 access_log_timed.t100644000765000024 704613761035266 22045 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse strict; use warnings; use Test::More; use HTTP::Request::Common; use Plack::Test; use Plack::Builder; BEGIN { eval "use Test::MockTime::HiRes; 1"; if ($@) { *mock_time = sub(&$) { my($code, $time) = @_; $code->(); } } } use Time::HiRes; 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@; } # Testing '%D' and '%T' $log = ''; my $wait_sec = 1; $handler = builder { enable "Plack::Middleware::AccessLog::Timed", logger => sub { $log .= "@_" }, format => '%T %D'; sub { return sub { Time::HiRes::sleep $wait_sec; $_[0]->( [ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ] ) } }; }; $test_req = sub { my $req = shift; test_psgi app => $handler, client => sub { my $cb = shift; $cb->($req); }; }; mock_time { $wait_sec = 1.2; $test_req->(GET "http://localhost/"); like $log, qr@^\d \d{7}@; # around '1 1200000' } time(); $log = ''; mock_time { $wait_sec = 0.3; $test_req->(GET "http://localhost/"); like $log, qr@^\d \d{6}\b@; # around '0 300000' } time(); done_testing; hello2.cgi100755000765000024 17213761035266 21531 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/cgi-bin#!/usr/bin/perl use CGI; my $q = CGI->new; print $q->header, "Hello ", scalar $q->param('name'), " counter=", ++$COUNTER; hello3.cgi100755000765000024 15013761035266 21526 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/cgi-bin#!/usr/bin/perl use Data::Dumper; print "Content-Type: text/plain\r\n\r\n"; print 'my ' . Dumper \%ENV; basic.t100644000765000024 165513761035266 21766 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/stacktraceuse 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; �����������������������������������������������������������������������������������force.t���������������������������������������������������������������������������������������������100644��000765��000024�� 1376�13761035266� 22003� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware/stacktrace�����������������������������������������������������������������������������������������������������������������������������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; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ConditionalGET.pm�����������������������������������������������������������������������������������100644��000765��000024�� 4461�13761035266� 22040� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/lib/Plack/Middleware��������������������������������������������������������������������������������������������������������������������������������������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]); # check both ETag and If-Modified-Since, and at least one should exist # and all present headers should match, not either. my @checks = ( $self->etag_matches($h, $env), $self->not_modified_since($h, $env) ) or return; unless (grep !$_, @checks) { $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) = @_; return unless $h->exists('ETag'); $h->get('ETag') eq _value($env->{HTTP_IF_NONE_MATCH}); } sub not_modified_since { my($self, $h, $env) = @_; return unless $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 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������HTTPExceptions.pm�����������������������������������������������������������������������������������100644��000765��000024�� 7642�13761035266� 22062� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/lib/Plack/Middleware��������������������������������������������������������������������������������������������������������������������������������������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 ����������������������������������������������������������������������������������������������unknown_response.t����������������������������������������������������������������������������������100644��000765��000024�� 775�13761035266� 21754� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/HTTP-Message-PSGI���������������������������������������������������������������������������������������������������������������������������������������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; ���auth_basic_simple.t���������������������������������������������������������������������������������100644��000765��000024�� 1455�13761035266� 22232� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware����������������������������������������������������������������������������������������������������������������������������������������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; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������bufferedstreaming.t���������������������������������������������������������������������������������100644��000765��000024�� 2065�13761035266� 22251� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware����������������������������������������������������������������������������������������������������������������������������������������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"; }; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������streaming.t�����������������������������������������������������������������������������������������100644��000765��000024�� 2210�13761035266� 22121� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware/cascade��������������������������������������������������������������������������������������������������������������������������������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; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������cgi_dir.cgi�����������������������������������������������������������������������������������������100755��000765��000024�� 545�13761035266� 21750� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware/cgi-bin��������������������������������������������������������������������������������������������������������������������������������#!/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; �����������������������������������������������������������������������������������������������������������������������������������������������������������log4perl-category.t���������������������������������������������������������������������������������100644��000765��000024�� 2022�13761035266� 22111� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware����������������������������������������������������������������������������������������������������������������������������������������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-category.log"; my $conf = <<CONF; log4perl.logger.0 = INFO, Logfile log4perl.appender.Logfile = Log::Log4perl::Appender::File log4perl.appender.Logfile.filename = $test_file log4perl.appender.Logfile.layout = Log::Log4perl::Layout::SimpleLayout CONF Log::Log4perl::init(\$conf); my $app = sub { my $env = shift; $env->{'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; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������rearrange_headers.t���������������������������������������������������������������������������������100644��000765��000024�� 2026�13761035266� 22213� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware����������������������������������������������������������������������������������������������������������������������������������������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; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������sigdie.t��������������������������������������������������������������������������������������������100644��000765��000024�� 1033�13761035266� 22137� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware/stacktrace�����������������������������������������������������������������������������������������������������������������������������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; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������AccessLog�������������������������������������������������������������������������������������������000755��000765��000024�� 0�13761035266� 20375� 5����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/lib/Plack/Middleware��������������������������������������������������������������������������������������������������������������������������������������Timed.pm��������������������������������������������������������������������������������������������100644��000765��000024�� 6114�13761035266� 22137� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/lib/Plack/Middleware/AccessLog����������������������������������������������������������������������������������������������������������������������������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 => scalar Time::HiRes::tv_interval($time, $now) * 1_000_000, 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 => scalar Time::HiRes::tv_interval($time, $now) * 1_000_000, 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 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������IIS7KeepAliveFix.pm���������������������������������������������������������������������������������100644��000765��000024�� 2203�13761035266� 22175� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/lib/Plack/Middleware��������������������������������������������������������������������������������������������������������������������������������������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 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������RearrangeHeaders.pm���������������������������������������������������������������������������������100644��000765��000024�� 2617�13761035266� 22440� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/lib/Plack/Middleware��������������������������������������������������������������������������������������������������������������������������������������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 �����������������������������������������������������������������������������������������������������������������iis7_keep_alive_fix.t�������������������������������������������������������������������������������100644��000765��000024�� 1617�13761035266� 22464� 0����������������������������������������������������������������������������������������������������ustar�00miyagawa������������������������staff���������������������������000000��000000��Plack-1.0048/t/Plack-Middleware����������������������������������������������������������������������������������������������������������������������������������������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~<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head> <title>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; streaming.t100644000765000024 137713761035266 22562 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/recursiveuse 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; BufferedStreaming.pm100644000765000024 334013761035266 22624 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 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 interface, unless you set C option (see below). =head1 OPTIONS =over 4 =item force Force enable this middleware only if the container supports C. =back =head1 AUTHOR Yuval Kogman Tatsuhiko Miyagawa =cut IIS6ScriptNameFix.pm100644000765000024 227113761035266 22401 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 and C set by IIS6. =head1 AUTHORS Florian Ragwitz =cut iis6_script_name_fix.t100644000765000024 416413761035266 22663 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; streaming.t100644000765000024 103113761035266 22662 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/stacktraceuse 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; empty_delayed_writer.t100644000765000024 76213761035266 22554 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Message-PSGIuse strict; use warnings; use Test::More; use HTTP::Message::PSGI; use HTTP::Request; use HTTP::Response; my $app = sub { my ($env) = @_; return sub { my ($responder) = @_; my $writer = $responder->([ 200, [] ]); $writer->close; }; }; my $env = req_to_psgi(HTTP::Request->new(POST => "http://localhost/post", [ ], 'hello')); my $response = HTTP::Response->from_psgi($app->($env)); is($response->content, '', 'delayed writer without write gives empty content'); done_testing; access_log_value_zero.t100644000765000024 137213761035266 23112 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; conditionalget_writer.t100644000765000024 163213761035266 23153 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; lint_utf8_false_alarm.t100644000765000024 75213761035266 23000 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; simple_content_filter.t100644000765000024 103413761035266 23140 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; SimpleContentFilter.pm100644000765000024 264113761035266 23165 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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. Plack::Middleware::SimpleContentFilter is a simple content text filter to run against response body. This middleware is only enabled against responses with C Content-Type. =head1 AUTHOR Tatsuhiko Miyagawa =cut lint_wrong_header_info.t100644000765000024 261013761035266 23256 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse strict; use Plack::Test; use Test::More; use HTTP::Request::Common; use Plack::Builder; use Plack::Middleware::Lint; my @CASES = ( { app => sub { return [ 200, [ foo => "bar" ], [ 'OK' ] ]; }, die => undef, }, { app => sub { return [ 200, [ foo => undef ], [ 'OK' ] ]; }, die => qr/Response headers MUST be a defined string. Header: foo/, }, { app => sub { return [ 200, [ "foo\nbar" => "baz" ], [ 'OK' ] ]; }, die => qr/Response headers MUST NOT contain a key with.+Header: foo\nbar/, }, { app => sub { return [ 200, [ foo => "\021bar" ], [ 'OK' ] ]; }, die => qr/Response headers MUST NOT contain characters below octal.+Header: foo/, }, { app => sub { return [ 200, [ "foo\021" => "bar" ], [ 'OK' ] ]; }, die => qr/Response headers MUST consist only of letters, digits, _ or.+Header: foo\021/, }, ); for my $case ( @CASES ) { my $linted_app = Plack::Middleware::Lint->wrap( $case->{app} ); my $die_reason = $case->{die}; test_psgi $linted_app, sub { my $cb = shift; my $res = $cb->(GET "/"); if ( $die_reason ) { is $res->code, 500, "Code of ". $res->content; like $res->content, $die_reason, "Text of ". $res->content; } else { is $res->code, 200, $res->content; } }; } done_testing; LighttpdScriptNameFix.pm100644000765000024 437013761035266 23450 0ustar00miyagawastaff000000000000Plack-1.0048/lib/Plack/Middlewarepackage 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 and C 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 flag inside C instead of using this middleware. =head1 CONFIGURATION =over 4 =item script_name Even with C, lighttpd I sets weird C and C if you mount your application at C<""> or something that ends with C. Setting C option tells the middleware how to reconstruct the new correct C and C. If you mount the app under C, you should set: enable "LighttpdScriptNameFix", script_name => "/something"; and when a request for C comes, C becomes C and C becomes C. C option is set to empty by default, which means all the request path is set to C and it behaves like your fastcgi application is mounted in the root path. =back =head1 AUTHORS Yury Zavarin Tatsuhiko Miyagawa =head1 SEE ALSO L L L =cut empty_streamed_response.t100644000765000024 116213761035266 23306 0ustar00miyagawastaff000000000000Plack-1.0048/t/HTTP-Message-PSGIuse 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; httpexceptions_streaming.t100644000765000024 236213761035266 23707 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; throw_streaming.t100644000765000024 150013761035266 23771 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/recursiveuse 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; error_document_streaming_app.t100644000765000024 430713761035266 24516 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middlewareuse 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; multiple_exceptions.t100644000765000024 545113761035266 24777 0ustar00miyagawastaff000000000000Plack-1.0048/t/Plack-Middleware/stacktraceuse 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;