diff options
| author | Nick Morrott <nickm@debian.org> | 2020-01-02 21:37:21 +0100 |
|---|---|---|
| committer | Nick Morrott <nickm@debian.org> | 2020-01-02 21:37:21 +0100 |
| commit | cb1bc58155756753c8551d4e877971cbe529df58 (patch) | |
| tree | 8e0da03f1e1c2c0edbc554bb720951ba0c74497d | |
Import libdancer2-perl_0.300000+dfsg.orig.tar.xz
[dgit import orig libdancer2-perl_0.300000+dfsg.orig.tar.xz]
385 files changed, 43980 insertions, 0 deletions
diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 00000000..1f28a349 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,2 @@ +See perldoc Dancer2.pm, section AUTHORS, for a list of core developers and +contributors. diff --git a/Changes b/Changes new file mode 100644 index 00000000..9d25b763 --- /dev/null +++ b/Changes @@ -0,0 +1,1671 @@ +0.300000 2019-12-23 23:55:09-06:00 America/Chicago + + [ BUG FIXES ] + * None + + [ ENHANCEMENTS ] + * GH #1127, GH #1476: Route parameters with types (Peter Mottram - + SysPete) + + [ DOCUMENTATION ] + * None + +0.208002 2019-12-14 16:08:46-05:00 America/New_York + + [ BUG FIXES ] + * GH#1527: Update travis dist to 'trusty' (Sergiy Borodych) + + [ ENHANCEMENTS ] + * GH #1525: Remove use of Return::MultiLevel, and implement stack frame + jumping manually (Graham Knop) + + [ DOCUMENTATION ] + * GH #1505: Fix Flaskr link (Mohammad S Anwar) + * GH #1506, 1520: Explain what add_route() does with args (Tom Hukins) + * GH #1519: Fix Template Toolkit config docs (Tom Hukins) + * GH #1522: Fix itetare typo (Stefan Hornburg - Racke) + * GH #1523: Fix typo in Template Toolkit documentation (Mike Katasonov) + * GH #1524: Fix error in configuration documentation (Tom Hukins) + * GH #1526: Mention that TT2 config start_tag/end_tag need escaping + (Chris White) + * GH #1528: Note that"Engines" key must be merged in config.yml (Chris + White) + +0.208001 2019-08-04 21:06:25-04:00 America/New_York + + [ BUG FIXES ] + * GH #1515: Add Types::Standard to cpanfile (Russell @veryrusty Jenkins) + + [ ENHANCEMENTS ] + * None + + [ DOCUMENTATION ] + * GH #1513: Fix Dancer2::Test typo (Utkarsh Gupta) + +0.208000 2019-06-19 10:21:16-04:00 America/New_York + + [ BUG FIXES ] + * PR #1493: Fix body not being sent on forward (Johannes Piehler) + * PR #1498: Load missing Encode in logger role (simbabque) + * PR #1501: Set :raw when copying files to new project (xenu) + * GH #1502: Update jquery (racke) + + [ ENHANCEMENTS ] + * GH #1320: Implement prepare_app keyword (Sawyer X) + + [ DOCUMENTATION ] + * Tidy up Cookbook POD. (Mohammad S Anwar) + +0.207000 2018-11-14 17:24:25-05:00 America/New_York + + [ BUG FIXES ] + * GH #1427: Allow layout_dir to be configured by set keyword (Russell + @veryrusty Jenkins) + * GH #1456: Engine logging respects minimum level filtering (Daniel Perrett) + * PR #1479: Remove arbitrary Perl 5.10 requirement from tests (Dan Book) + * PR #1480: Correct dynamic HTTP::XSCookies requirement (Dan Book) + * PR #1486: Install dzil deps for use by Appveyor (Dan Book) + + [ ENHANCEMENTS ] + * GH #1418: Send plain text content with send_as() (Steve Dondley) + * PR #1457: Serializer mutable with custom mapping. Also resolves issues + #795, #973, and #901 (Russell @veryrusty Jenkins, Yanick Champoux, + Daniel Böhmer, Steven Humphrey) + * PR #1459: Add no default middleware feature. Also resolves #1410 + (Russell @veryrusty Jenkins) + * GH #1469: Code of Conduct enhancements (MaxPerl) + + [ DOCUMENTATION ] + * GH #1166: Add behind_proxy docs to Deployment manual (Nuno Ramos + Carvalho) + * GH #1417: Add "set engines" documentation (Deirdre Moran) + * PR #1450: Add calculator example (Gabor Szabo) + * PR #1452: Fix Pod formatting for CPAN (simbabque) + * PR #1454: Fix typos in docs (Gil Magno) + * PR #1464: Can't set environment with 'set' keyword (Ben Kaufman) + * PR #1470: Use session for flash and explain in detail (simbabque) + * PR #1472: Migration, tutorial, other doc fixes (Jason A. Crome) + * PR #1473: Show support resources after generating new app (Jason A. + Crome) + * PR #1474: Use the correct URL for HAProxy (Jason A. Crome) + * PR #1475: Add manual section for security concerns (Jason A. Crome) + * PR #1487: Clarify deprecation of Dancer2::Test (Steve Dondley) + +0.206000 2018-04-19 22:09:46-04:00 America/New_York + + [ BUG FIXES ] + * GH #1090, #1406: Replace HTTP::Body with HTTP::Entity::Parser in + Dancer2::Core::Request. (Russell @veryrusty Jenkins) + * GH #1292: Fix multiple attribute definitions within Plugins + (Nigel Gregoire) + * GH #1304: Fix the order by which config files are loaded, independently + of their filename extension (Alberto Simões, Russell @veryrusty Jenkins) + * GH #1400: Fix infinite recursion with exceptions that use circular + references. (Andre Walker) + * GH #1430: Fix `dancer2 gen` from source directory when Dancer2 not + installed. (Tina @perlpunk Müller - Tina) + * GH #1434: Add `validate_id` method to verify a session id before + requesting the session engine fetch it from its data store. + (Russell @veryrusty Jenkins) + * GH #1435, #1438: Allow XS crush_cookie methods to return an arrayref + of values. (Russell @veryrusty Jenkins) + * GH #1443: Update copyright year (Joseph Frazer) + * GH #1445: Use latest HTTP::Headers::Fast (Russell @veryrusty Jenkins) + * PR #1447: Fix missing build requires (Mohammad S Anwar) + + [ ENHANCEMENTS ] + * PR #1354: TemplateToolkit template engine will log (at debug level) + if a template is not found. (Kiel R Stirling, Russell @veryrusty Jenkins) + * GH #1432: Support Content-Disposition of inline in + send_file() (Dave Webb) + * PR #1433: Verbose testing in AppVeyor (Graham Knop) + + [ DOCUMENTATION ] + * GH #1314: Documentation tweaks (David Precious) + * GH #1317: Document serializer configuration (sdeseille) + * GH #1386: Add Hello World example (Gabor Szabo) + * PR #1408: List project development resources (Steve Dondley) + * PR #1426: Move performance improvement information from Migration guide + to Deployment (Pedro Melo) + +0.206000_02 2018-04-09 21:48:24-04:00 America/New_York (TRIAL RELEASE) + + [ BUG FIXES ] + * GH #1090, #1406: Replace HTTP::Body with HTTP::Entity::Parser in + Dancer2::Core::Request. (Russell @veryrusty Jenkins) + * GH #1304: Fix the order by which config files are loaded, independently + of their filename extension (Alberto Simões, Russell @veryrusty Jenkins) + * GH #1400: Fix infinite recursion with exceptions that use circular + references. (Andre Walker) + * GH #1430: Fix `dancer2 gen` from source directory when Dancer2 not + installed. (Tina @perlpunk Müller - Tina) + * GH #1434: Add `validate_id` method to verify a session id before + requesting the session engine fetch it from its data store. + (Russell @veryrusty Jenkins) + * GH #1435, #1438: Allow XS crush_cookie methods to return an arrayref + of values. (Russell @veryrusty Jenkins) + * GH #1443: Update copyright year (Joseph Frazer) + * GH #1445: Use latest HTTP::Headers::Fast (Russell @veryrusty Jenkins) + + [ ENHANCEMENTS ] + * PR #1354: TemplateToolkit template engine will log (at debug level) + if a template is not found. (Kiel R Stirling, Russell @veryrusty Jenkins) + * GH #1432: Support Content-Disposition of inline in + send_file() (Dave Webb) + * PR #1433: Verbose testing in AppVeyor (Graham Knop) + + [ DOCUMENTATION ] + * GH #1317: Document serializer configuration (sdeseille) + * PR #1426: Move performance improvement information from Migration guide + to Deployment (Pedro Melo) + +0.205002 2017-10-17 16:08:25-05:00 America/Chicago + + [ BUG FIXES ] + * GH #1362: Make cookies http_only by default (David Precious) + * GH #1366: Use proper shebang on dancer script and make EU::MM do the job + * GH #1373: Unset Dancer environment vars before testing (Alberto Simões) + * GH #1380: Consider class of error displayed when using show_errors + (Nick Tonkin). + * GH #1383: Remove Deflater from default app skeleton (Pierre Vigier) + * GH #1385: Fix links inside the documentation (Alberto Simões) + * GH #1390: Honour no_server_tokens config in error responses (Russell + @veryrusty Jenkins) + + [ DOCUMENTATION ] + * GH #1285: Add "Default Template Variables" section to manual (simbabque) + * GH #1312: Fix docs for Dancer2::Core::Route->match, which takes a request + object (simbabque). + * GH #1368: Don't allow XSS in tutorial (simbabque) + * GH #1383: Remove full URL on links to third party modules (Alberto Simoes) + * GH #1395: Customize TT behavior via subclassing (simbabque). + +0.205001 2017-07-11 08:03:21-05:00 America/Chicago + + [ BUG FIXES ] + * GH #1332: Add check for old version of HTTP::XSCookies (Peter Mottram - + SysPete) + * GH #1336: Fix warnings on 5.10 and below. (Sawyer X) + * GH #1347: Add Perl versions 5.22-5.26 and appveyor to Travis-CI + configuration (Dave Jacoby) + + [ ENHANCEMENTS ] + * GH #1281: Use Ref::Util in Core for all reference checks (Mickey + Nasriachi) + * GH #1338: Add message explaining how to run newly-created application + (Jonathan Cast) + + [ DOCUMENTATION ] + * GH #1334: Fix prefix example in Cookbook (Abdullah Diab) + * GH #1335: Add missing word in request->host docs (Glenn Fowler) + * GH #1337: Fix link in SEE ALSO section of Dancer2::Core::Types (Stefan + Hornburg - Racke) + * GH #1341: Clarify plugin documentation (Stefan Hornburg - Racke) + * GH #1345, #1351, #1356: Fix password check code example in tutorial + (Jonathan Cast) + * GH #1355: Fix typo (Gregor Herrmann) + +0.205000 2017-03-10 15:37:52-06:00 America/Chicago + + [ BUG FIXES ] + * GH #1325: Support multi-value cookies when using HTTP::XSCookies. + (James Raspass) + * GH #1303: Read configuration options when send_as() creates a new + serializer (Paul Williams) + * GH #1290: Properly check buffer length in _read_to_end() (Marketa + Wachtlova) + * GH #1322: Deprecate broken request->dispatch_path in favor of + request->path. Warn the developer of the deprecation (Russell + @veryrusty Jenkins). + + [ ENHANCEMENTS ] + * GH #1326: Speed up by using Type::Tiny, again. (Pete SysPete Mottram) + * GH #1318: Add support for the SameSite cookie attribute. (James Raspass) + * GH #1283: Skeleton now provides an example of setting the appdir. + (Jason Lewis) + * GH #1315: Adjust dist.ini to set "build_requires" for + ExtUtils::MakeMaker. (Atoomic) + * GH #1331: Preliminary prepare_app() work (Sawyer X) + + [ DOCUMENTATION ] + * GH #1324: Fix broken link to send_file. (Fabrice Gabolde) + * GH #1311: Typo and link fixes. (Breno G. de Oliveira - @garu) + * GH #1310: Document query string parameters in uri_for. (Michael J South) + * GH #1329: Remove dead code from file upload example (Stefan Hornburg - + Racke) + * GH #1256: Additions to migration manual (Daniel Perrett) + * GH #1330: Add middleware examples to scaffolder (David - sbts) + +0.204004 2017-01-26 18:29:34+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #1307: Fix breakage of Template::Toolkit, caused by + previous release. (Peter SysPete Mottram) + +0.204003 2017-01-25 15:21:40-06:00 America/Chicago + + [ BUG FIXES ] + * GH #1299: Fix missing CPANTS prereqs (Mohammad S. Anwar) + + [ ENHANCEMENTS ] + * GH #1249: Improve consistency with Template::Toolkit, + using correct case for 'include_path', 'stop_tag', 'end_tag', + and 'start_tag', removing ANYCASE option. + (Klaus Ita) + * Call route exception hook before logging an error, allowing devs to + raise their own errors bedore D2 logging takes over. (Andy Beverley) + + [ DOCUMENTATION ] + * Add another example of the delayed asynchronous mechanism + (Ed @mohawk2 J., Sawyer X) + * GH #1291: Document 'change_session_id' in Dancer2::Core::App. + (Peter SysPete Mottram) + * Fix typo in Dancer2::Core::Response (Gregorr Herrmann) + * Document Dancer2::Plugin::RootURIFor (Mario Zieschang) + +0.204002 2016-12-21 15:40:02-06:00 America/Chicago + + [ BUG FIXES ] + * GH #975: Fix "public_dir" configuration to work, just like + DANCER_PUBLIC. (Sawyer X) + + [ ENHANCEMENTS ] + * You can now call '$self->find_plugin(...)' within a plugin + in order to find a plugin, in order to use its DSL in your + custom plugin. (Sawyer X) + + [ DOCUMENTATION ] + * GH #1282: Typo in Cookbook. (Kurt Edmiston) + * GH #1214: Update Migration document. (Sawyer X) + * GH #1286: Clarify hook behavior when disabling layout (biafra) + * GH #1280: Update documentation to use specific parameter + keywords (Hunter McMillen) + +0.204001 2016-10-17 08:29:00-05:00 America/Chicago + + [ BUG FIXES ] + * Restore 5.8 support (fix test which required captures). + (Russell @veryrusty Jenkins) + * PR #1271: fix wrong regex check against $_ (Mickey Nasriachi) + + [ ENHANCEMENTS ] + * GH #1262: Add 'encode_json' and 'decode_json' DSL, which are + recommended instead of 'to_json' and 'from_json'. + (Dennis @episodeiv lichtenthäler) + + [ DOCUMENTATION ] + * Fix some typos.(Dennis @episodeiv lichtenthäler) + * GH #1031: Remove D2::Core::Context remnants from docs. + (Sawyer X) + + [ PACKAGING ] + * GH #1273: Do not require Test::Perl::Critic to install. + (Dennis lichtenthäler) + +0.204000 2016-10-10 20:56:51-05:00 America/Chicago + + [ BUG FIXES ] + * GH #1255: Fix hook overriding in plugin. (Yves Orton) + * GH #1191: Named capture prior to dispatch breaks dispatch. + (Yves Orton) + * GH #1235: Clean up descriptions for HTTP codes 303 and 305. + (Yanick Champoux) + * Remove duplicate (and errornous) 451 error message. + (Sawyer X) + * GH #1116, #1245: Ensure cached Hash::MultiValue parameters are cloned + into the new request. (Russell @veryrusty Jenkins) + + [ ENHANCEMENTS ] + * You can now provide a $EVAL_SHIM to Dancer2::Core::App in order + to have custom code run on eval{} calls. One example of this + is to handle proper counting of stack frames when you want to + unwind/unroll the stack for custom error reporting. + (Yves Orton) + * Added a cpanfile to allow installing local dependencies with + carton. (Mickey Nasriachi) + * GH #1260: Specify optional charset to send_file and send_as + (Russell @veryrusty Jenkins) + * PR #1162: Change skeleton template tags so skeletons can generate + applications that use Template Toolkit default tags (Jason Lewis) + * GH #1149: Fix config loading inconsistencies, support local config + files in addition to standard Dancer conf files (Jonathan Scott Duff) + * PR #1269: Stash decoded body_parameters separately from those + in Plack::Request (Russell @veryrusty Jenkins) + * GH #1253: Static middleware should send 304 Not Modified to enable + intermediate level caching. (Russell @veryrusty Jenkins) + + [ DOCUMENTATION ] + * GH #608: Remove extra general COPYRIGHT notice in Tutorial. + (Sawyer X) + * Simplify upload example. (Alberto Simões, Sawyer X) + +0.203001 2016-09-03 20:59:47-05:00 America/Chicago + + [ BUG FIXES ] + * GH #1237: Specify minimum version of List::Util required for pair* + functionals. (Russell @veryrusty Jenkins) + + [ ENHANCEMENTS ] + * PR #1242: Replace Class::Load with Module::Runtime (Russell + Jenkins - @veryrusty) + +0.203000 2016-08-24 22:09:56-05:00 America/Chicago + + [ BUG FIXES ] + * GH #1232: Force deserialization of body data even when an existing + Plack::Request object has already parsed request body. Don't double + decode deserialized data. (Russell Jenkins - @veryrusty) + + [ ENHANCEMENTS ] + * GH #1195: Add change_session_id() method - both as a good security + practice and to comply with other established security standards. + (Peter Mottram) + * GH #1234: Add convenience functions to access Dancer's HTTP_CODES + table. (Yanick Champoux) + + [ DOCUMENTATION ] + * Fix Typo (Stefan Hornburg - Racke) + * Document $session->data (Stefan Hornburg - Racke) + +0.202000 2016-08-13 13:50:30-05:00 America/Chicago + + [ BUG FIXES ] + * Fix memory leak in plugins. (Sawyer X) + * GH #1180, #1220: Revert (most of) GH #1120. Change back to using + MooX::Types::MooseLike until issues around Type::Tiny are resolved. + Peter (@SysPete) Mottram + * GH #1192: Decode body|query|request_parameters (Peter Mottram) + * GH #1224: Plugins defined with :PluginKeyword attribute are now + exported. (Yanick Champoux) + * GH #1226: Plugins can now call the DSL of the app via $self->dsl + (Sawyer X) + + [ ENHANCEMENTS ] + * PR #1223: Add YAML::XS to Recommends (Peter Mottram) + * PR #1117: If installed, use HTTP::XSCookies and all cookie operations + will be faster (Peter Mottram) + * PR #1228: Allow register_plugin() to pass @_ properly (Sawyer X) + * PR #1231: Plugins can now call the syntax of plugins they loaded + (Sawyer X) + + [ DOCUMENTATION ] + * PR #1151: Note that config is immutable after first read (Peter Mottram) + * PR #1222: Update list of files generated by `dancer2 -a`, make name of + sample app consistent (Daniel Perrett) + +0.201000 2016-07-22 08:26:18-05:00 America/Chicago + + [ BUG FIXES ] + * GH #1216: Make DSL work in edge-case of plugins calling DSL before the + app class loaded Dancer2. (Sawyer X) + * GH #1210: Show proper module/line number in log output (Masaaki Saito) + + [ ENHANCEMENTS ] + * GH #900: Switch from to_json to encode/encode_json (Nuno Ramos Carvalho) + * GH #1196: Move serializer from JSON to JSON::MaybeXS (Nuno Ramos Carvalho) + * GH #1215: Remove unused DANCER2_SHARE_DIR env variable (Jason A. Crome) + + [ DOCUMENTATION ] + * PR #1213: Clarify params merging docs and related examples + (Daniel Perrett) + * Add Peter Mottram (@SysPete) to list of core developers. (Russell Jenkins) + * PR #1208: Introduce appdir before it's used; simplify description of what + a view is (James E Keenan) + * GH #1218: By request, remove David Golden from list of core developers. + Created "emeritus" section to honor the contributions of former core + developers. Thanks, xdg! + +0.200003 2016-07-11 17:17:57+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * PR #1198: Session::YAML should not accept bad session cookie value + from client (Peter Mottram) + * Require minimum version of YAML of 0.86 (to satisfy GH #899) and a + maximum version of YAML 1.15. YAML 1.16 causes test failures as + reported by CPAN Testers. + * Remove session test data from builds. (Peter Mottram) + + [ ENHANCEMENTS ] + * Require minimum version of ExtUtils::MakeMaker of 7.1101 to support + a range of prereq version numbers (rjbs, Jason Crome, Sawyer X) + * GH #1188: Add error message to open_file (exercism-1) + * Support showing private variables in templates under + Template::Toolkit. (Alberto Simões) + + [ DOCUMENTATION ] + * GH #1193: Spelling correction (Gregor Herrmann) + * Fix typo of config option in Pod. (Nuno Carvalho) + * Fix POD syntax error. (Nuno Carvalho) + * Fix Manual error. (James E Keenan) + * Move documentation index to dancer2. (Alan Berndt) + * GH #1209: Clean up examples for 'set views' and 'set public_dir' + in Dancer2::Manual (James E Keenan) + +0.200002 2016-06-22 16:39:13+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * Using `var` with a `forward`ed request now works. + (Sawyer X, Jason Crome) + + +0.200001 2016-06-16 15:51:04+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #1175: Plugins are not required to be in the Dancer2::Plugin + namespace. (Russell @veryrusty Jenkins) + * GH #1176, #1177: Remove Test::Deep as a test dependency. + (Nuno Carvalho, Peter Mottram) + * GH #1185: Fails on 5.25.1. (Tony Cook) + + [ DOCUMENTATION ] + * GH #1178: Update D2::Manual with links to new plugin architecture. + (Joel Berger, Jason A. Crome) + * GH #1184: Use 'before_template_render' rather than the special case + 'before_template' in D2::Manual and D2::Tutorial (Philippe Bricout) + + [ ENHANCEMENTS ] + * GH #1018: Additional plugin hook tests (Ruben Amortegui) + +0.200000 2016-05-31 15:05:46+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #1174: Update plugin tests to stop deprecation warnings + (Peter Mottram) + * GH #1173: Reword error when serialization / deserialization fails + to be more generic (Russell @veryrusty Jenkins) + + [ ENHANCEMENTS ] + * Introduce an improved variation of the Dancer2::Plugin::SendAs + into core. You can now override the serializer (or lack thereof) + at any point in time for a response by calling `send_as`. You + can also send the options of `send_file` (like the Content-Type) + and the charset for the app is also respected. + (Russell @veryrusty Jenkins) + +0.166001_04 2016-05-27 14:54:53+02:00 Europe/Amsterdam (TRIAL RELEASE) + + [ BUG FIXES ] + * GH #1171: Ensure request query parameter parsing is independent of + Plack version (Russell Jenkins) + +0.166001_03 2016-05-27 13:23:52+02:00 Europe/Amsterdam (TRIAL RELEASE) + + [ BUG FIXES ] + * GH #1165, #1167: Copy is_behind_proxy attribute into new request + on forward. (Russell Jenkins) + + [ ENHANCEMENTS ] + * GH #1120: Move from MooX::Types::MooseLike to Type::Tiny for + performance. (Peter Mottram) + * GH #1145, #1164: Replace Class::Load with Module::Runtime + (Sawyer X) + * GH #1159, #1163: Make template keyword global. + (Sawyer X, Russell Jenkins) + + [ DOCUMENTATION ] + * GH #1158: List both static and shared modules in Apache's deploy + instructions. (Varadinsky) + +0.166001_02 2016-04-29 16:42:54+02:00 Europe/Amsterdam (TRIAL RELEASE) + + + [ BUG FIXES ] + * GH #1160: Engines receive correct log callback on build + (Peter Mottram) + * GH #1148: Ensure request body parameter parsing is independent of + Plack version (Russell Jenkins) + +0.166001_01 2016-04-19 21:50:35+02:00 Europe/Amsterdam (TRIAL RELEASE) + + [ BUG FIXES ] + * GH #1102: Handle multiple '..' in file path utilities. + (Oleg A. Mamontov, Peter Mottram) + * GH #1114: Fix missing prereqs as reported by CPANTS. + (Mohammad S Anwar) + * GH #1128: Shh warning if optional megasplat is not present. + (David Precious) + * GH #1139: Fix incorrect Content-Length header added by AutoPage + handler (Michael Kröll, Russell Jenkins) + * GH #1144: Change tt tags to span in skel (Jason Lewis) + * GH #1046: "no_server_tokens" configuration option doesn't work. + (Sawyer X) + # GH #1155, #1157: Fix megasplat value splitting when there are empty + trailing path segments. (Tatsuhiko Miyagawa, Russell Jenkins) + NOTE: Paths matching a megasplat that end with a '/' will now include + an empty string as the last value. For the route pattern '/foo/**', + the path '/foo/bar', the megasplat gives ['bar'], whereas '/foo/bar/' + now gives ['bar','']. Joining the array of megasplat values will now + always be the string matched against for the megasplit. + + [ DOCUMENTATION ] + * GH #1119: Improve the deployment documentation. (Andrew Beverley) + * GH #1123: Document import of utf8 pragma. (Victor Adam) + * GH #1132: Fix spelling mistakes in POD (Gregor Herrmann) + * GH #1134: Fix spelling errors detected by codespell (James McCoy) + * GH #1153: Fix POD rendering error. (Sawyer X) + + [ ENHANCEMENTS ] + * GH #1129: engine.logger.* hooks are called around logging a message. + (Russell @veryrusty Jenkins) + * GH #1146: Cleaner display of error context (Vernon Lyon) + * GH #1085: Add consistent keywords for accessing headers; + 'request_header' for request, 'response_header', 'response_headers' + and 'push_response_header' for response. (Russell @veryrusty Jenkins) + * GH #1010: New Dancer2::Plugin architecture, includes support for + plugins using other plugins. (Yanick Champoux, Russell Jenkins, + Sawyer X, Damien Krotkine, Stefan @racke Hornburg, Peter Mottram) + Note: Considerable effort has gone into working with the authors + of existing plugins to ensure their plugins are compatible with both + the 'old' and the new reworked plugin architecture. Please upgrade + your plugins to a recent release. + (Special thanks to Peter @SysPete Mottram) + +0.166001 2016-01-22 07:54:46+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #1105, #1106, #1108: Autopage + Template Toolkit broke in last + release. (Kaitlyn Parkhurst @symkat, Russell Jenkins) + +0.166000 2016-01-12 19:01:51+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #1013, #1092: Remove race condition caused by caching available + engines. (Sawyer X, Menno Blom, Russell Jenkins) + * GH #1089: Exact macthing of route regex comments for tokens/splats. + (Sawyer X) + * GH #1079, #1082: Allow routes to return '0' as response content, + and serializer hooks are called when default response content is + to be returned. (Alberto Simões, Russell Jenkins) + * GH #1093, 1095: Use a dynamic TT2 INCLUDE_PATH to allow relative + views with relative includes; fixing regression introduced by #1037. + (Russell Jenkins) + * GH #1096, #1097: Return compatibility on Perl 5.8.x! + (Peter Mottram - @SysPete) + + [ DOCUMENTATION ] + * GH #1076: Typo in Dancer2::Core::Hook POD. (Jonathan Scott Duff) + + [ ENHANCEMENTS ] + * GH #1074: Add sample session engine config to skeleton app. + (Peter Mottram - @SysPete) + * GH #1088: Return route objects when defining new routes. + (Sawyer X) + +0.165000 2015-12-17 09:19:13+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * Revert session_name change, as this would invalidate all existing + changes. We will need to rethink this change. + (Stefan @racke Hornburg, Sawyer X) + +0.164000 2015-12-16 23:42:24+01:00 Europe/Amsterdam + + [ DOCUMENTATION ] + * Update core team members and contributors list. (Russell Jenkins) + * GH #1066: Fix typo in Cookbook. (gertvanoss) + * Correct typo. It's "query_parameters", not "request_parameters". + Thanks to mst for letting me know and making sure I fix it! + (Sawyer X) + + [ BUG FIXES ] + * GH #1040: Forward with a post body no longer tries to re-read body + filehandle. (Bas Bloemsaat) + * GH #1042: Add Diggest::SHA as explicit prequisite for installs on + perl < v5.9.3. (Russell Jenkins) + * GH #1071, #1070: HTML escape the message in the default error page. + (Peter Mottram) + * GH #1062, #1063: Command line interface didn't support + "-s SKELETON_DIRECTORY" in any order. + (Nuno Carvalho) + * GH #1052, #1053: Always call before_serializer hook when serializer + is set. + (Mickey Nasriachi) + * GH #1034: Correctly use different session cookie name for Dancer2. + (Jason A. Crome) + * GH #1060: Remove trailing slashes when providing skeleton + directory. + (Gabor Szabo) + + [ ENHANCEMENTS ] + * Use Plack 1.0035 to make sure you only have HTTP::Headers::Fast + in the Plack::Request object internally. + * GH #951 #1037: Dancer2::Template::TemplateToolkit no longer sets TT2 + INCLUDE_PATH directive, allowing `views` setting to be non-absolute + paths. (Russell Jenkins) + * GH #1032 #1043: Add .dancer file to new app scaffolding. + (Jason A. Crome) + * GH #1045: Small cleanups to Request class. (Russell Jenkins) + * GH #1033: strict && warnings in Dancer2::CLI. (Mohammad S Anwar) + * GH #1052, #1053: Allow before_serializer hook to change the content + using @_. + (Mickey Nasriachi) + * GH #1060: Ignore .git directory when using an external skeleton + directory. + (Gabor Szabo) + * GH #1060: Support more asset file extensions. (Gabor Szabo) + * GH #1072: Add request->is_options(). (Theo van Hoesel) + +0.163000 2015-10-15 12:47:57+02:00 Europe/Amsterdam + + [ DOCUMENTATION ] + * GH: #1030: Fix pod references pointing to Dancer package + (Mohammad S Anwar, Russell Jenkins) + +0.162000_01 2015-10-13 17:05:09+02:00 Europe/Amsterdam (TRIAL RELEASE) + + [ BUG FIXES ] + * GH #996: Fix warning with optional arguments. (Bas Bloemsaat) + * GH #1001: Do not trigger an internal error on 404. (Russell Jenkins) + * GH #1008,#976: Hack to quiet warning while plugins + architecture is being rewritten. (Russell Jenkins) + * Use Safe::Isa when calling their functions in the respected eval. + (Sawyer X) + + [ ENHANCEMENTS ] + * GH #738, #740, #988: route_parameters, query_parameters, and + body_parameters keywords added, providing Hash::MultiValue objects! + (Sawyer X) + * #941, #999: delayed() keyword now has "on_error" option for controlling + errors. + (Sawyer X) + * dancer2 app now support -s switch to supply an app skeleton + (Nuno Carvalho) + * "perl_version" token in templates now uses $^V, not $]. (Sawyer X) + * GH #966: Remove Dist::Zilla::Plugin::AutoPrereqs. (Vernon) + * GH #992: Deprecate creating route named placeholders ":captures" + and ":splat". (Sawyer X) + * Bump Moo requirement to 2.000000. (Alberto Simões) + * GH #1012: Add :nopragmas import flag. (Sawyer X) + + [ DOCUMENTATION ] + * GH #974: Use correct classname. (Sawyer X) + * GH #958: Fix manual example with loading additional routes. (Sawyer X) + * GH #960: Fix a few links. (Sawyer X) + * Document you can install Scope::Upper for greater speed. (Sawyer X) + * GH #1000: Correct POD name for Dancer2::Manual::Deployment. + (Jason A. Crome) + * GH #1017: Fix instructions on running app.psgi. Highlight + beginner-friendly application running instructions. (Jason Crome) + * GH #920, #1020: Remove deprecated functionality from example plugin. + (Jason Crome) + * GH #1002: Correct execute_hook() call in plugins documentation. + (Jason Crome) + * Expand on auto-reloading options using Plack Shotgun loader. + (Jason Crome, @girlwithglasses) + * GH #1024: Document the need to define static_handler when changing + the public_dir option. (Sébastien Deseille) + +0.162000 2015-09-06 13:08:05+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * Not exactly bug fix, but now captures() always returns hashref. + (Sawyer X) + * GH #931: Using params() keyword, route parameters now override body + parameters which override query parameters. (Sawyer X) + + [ ENHANCEMENTS ] + * Small speed bump: use eval{} instead of Try::Tiny. (Sawyer X) + + [ DOCUMENTATION ] + * Replace File::Slurp with File::Slurper in tutorial. + (Nick Tonkin) + +0.161000_01 2015-08-28 15:29:00+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #947, #948: Escape file paths in regex patterns. (A. Sinan Unur) + * GH #944: Setting response content in before hook when a serializer + is set no longer triggers an error. + (Russell Jenkins, Dmitrii Tcyganov) + * GH #965: Remove non-existant role from Response::Delayed. + (Vernon, Russell Jenkins) + * GH #971: Route options matching no longer uses each iterator. + (Tina Müller) + * GH #959: Custom error template rendering fixed. (Russell Jenkins) + * GH #961: Render custom error templates in before hooks. (Russell Jenkins) + * GH #978: Tests - fix response regex after html_encode (Vernon) + * GH #972: Exceptions thrown by serializers no longer masked. + (Russell Jenkins) + + [ DOCUMENTATION ] + * GH #967: Fix upload example. (Alberto Simões) + * GH #881: Add cookie timeout example. (Andy Beverley) + * GH #963: Document all available template tokens. (Sawyer X) + + [ ENHANCEMENTS ] + * Optimize the s*#t out of basic routing. Faster than Dancer 1 now. + (Sawyer X) + * Only load HTTP::Server::PSGI when asked to start a development + server not under Plack. (Sawyer X, Mickey Nasriachi) + * GH #949: Produce cleaner, non-verbose test output (Vernon) + * GH #950: Decode characters in param keys (Patrick Zimmermann) + * GH #914: Include stack trace on default error page when + show_errors is true. (Vernon) + * GH #980, #981: halt keyword sets response content if provided, + as Dancer 1 does. (Achilles Kars) + * GH #909, #957, #983: HTML5 templates in generated apps and + default error template (Gabor Szabo, Kadir, Vernon) + * GH #972, #719, #969, #644, #647: Streamline serializer helpers. + to_json/from_json now faster. (Russell Jenkins) + +0.161000 2015-07-08 14:57:16+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #915, #930: Check existence of optional extension headers when + behind proxy. (Andy Beverley, Pedro Melo, Russell Jenkins) + * GH #926, #940: Set session directory default to $apprdir/session. + (Russell Jenkins) + * GH #936, #939: Use the error_template configuration on a 404. + (Russell Jenkins) + * GH #844, #937: Non-hash serialized params do not cause a crash. (Sawyer X) + * GH #943: Pass @_ to UNIVERSAL's VERSION so it validates version number. + (Sawyer X) + * GH #934: Cleanup internals in the old Dispatcher. (Russell Jenkins) + + [ DOCUMENTATION ] + * Sanitize Changes + * GH #938: Fix POD link to params keyword. (Ludovic Tolhurst-Cleaver) + * GH #935: Provide more details and considerations when using + behind_proxy. (Andy Beverley) + + [ ENHANCEMENT ] + * GH #933: use note in tests to produce cleaner non-verbose output (Vernon) + * Remove unnecessary dependencies: build chain should be smaller. (Sawyer X) + * No need for Module::Build. (Sawyer X) + * GH #911: Dancer2 request object is now a subclass of Plack::Request. + It's also much faster now. (Sawyer X) + +0.160003 2015-06-06 11:09:00+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #921, #922: Plack >= 1.0035. (Russell Jenkins, Alberto Simões) + + [ ENHANCEMENT ] + * #922: Use HTTP::Headers::Fast in request and response objects + (Russell Jenkins) + +0.160002 2015-06-04 13:03:38+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #920: Sanitize session IDs in file-based sessions. + (Russell Jenkins, Andrew Beverley) + + [ DOCUMENTATION ] + * GH #908: Cleanup Dancer references in DBIC section of cookbook + (Julien Fiegehenn) + * GH #910: Misc spelling and grammar fixes (Gregor Herrmann) + * GH #916: Fix test example. (Peter Mottram - @SysPete) + * GH #912, #913: Fix documentation on when stacks are printed. + (Andrew Solomon) + +0.160001 2015-05-14 20:40:10+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #893, #895: Catch config parse errors when Config::Any doesn't throw + them. (Russell Jenkins) + * GH #899: Minimum YAML version supported is v0.86 (Shlomi Fish) + * GH #906: send_file - missing import and fix logic error for streaming + by default (Russell Jenkins) + + [ DOCUMENTATION ] + * GH #897: Remove docs for unimplemented 'load' keyword (Fayland Lam) + + [ ENHANCEMENT ] + * GH #894, #898: Add status and headers methods to ::Response::Delayed + (Yanick Champoux, Charlie Gonzalez) + +0.160000 2015-04-27 00:12:55+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #868: Fix incorrect access name in $error->throw. (cdmalon) + * GH #879, #883: Fix version numbering in packaging and tests. + (Russell Jenkins) + * File serving (send_file) won't call serializer. (Russell Jenkins) + * GH #892, #510: Workaround for multiple plugins with hooks. + (Russell Jenkins, Alberto Simões) + * GH #558: Remove "prefix" inconsistency with possibly missing postfixed + forward slash. (Sawyer X) + + [ DOCUMENTATION ] + * GH #816, #874 Document session engine changes in migration documentation. + (Chenchen Zhao) + * GH #866, #870: Clarify that you cannot forward to a static file, why, + and two different ways of accomplishing it without forward. + (Sakshee Vijayvargia) + * GH #878: Rework example for optional named matching due to operator + precedence. (Andrew Solomon) + * GH #844: Document Simple session backend is the default. (Sawyer X) + + [ ENHANCEMENT ] + * GH #869: Streaming file serving (send_file). (Russell Jenkins) + * GH #793: "prefix" now supports the path definition spec. (Sawyer X) + * GH #817, #845: Route spec under a prefix doesn't need to start with + a slash (but must without a prefix). + (Sawyer X, Russell Jenkins) + * GH #871: Use Safe.pm instead of eval with Dancer2::Serializer::Dumper. + (David Zurborg) + * GH #880: Reduce and cleanup different logging calls in order to handle + the stack frames traceback for logging classes. (Russell Jenkins) + * GH #857, #875: When failing to render in Template::Toolkit, make the + error reflect it's a TT error, not an internal one. + (valerycodes) + +0.159003 2015-03-23 14:57:15+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * Fixed another memory leak with compiled hooks. (Sawyer X) + * Fixed a memory leak with conditionally applied static middleware + (Russell Jenkins) + + [ DOCUMENTATION ] + * GH #854, #858: Fix after_template_render hook example. (Adam Weinberger) + * GH #861: Improve documentation of 'forward'. (Andy Beverley) + +0.159002 2015-03-03 19:21:21+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #856: Memory leak when throwing exception from a hook. (Sawyer X) + +0.159001 2015-02-25 15:31:35+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #855: Ensure Dancer2::Test is compatible with Pod::Simple 3.30. + (Russell Jenkins) + + [ DOCUMENTATION ] + * Add an example for delayed (async) streaming response. (Sawyer X) + * Small link fix. (Sawyer X) + +0.159000 2015-02-24 04:51:20+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #762: Delay app cleanup until errors are rendered. (Russell Jenkins) + * GH #835: Correct Logic error in Logger if no request exists. + (Lennart Hengstmengel) + * GH #839: Correct "no_server_tokens" definition in production.yml. + (Nikita K) + * GH #853, #852: Handle malformed (contentless) cookies. (pants) + * GH #840, #842: Ensure session data available to template engines. + (Russell Jenkins) + * GH #565, #847, #849: Fix HTTP Status template logic and documentation. + (Daniel Muey, Russell Jenkins, Dávid Kovács) + * GH #843: Add missing attributes to Moo class used in tests. (Graham Knop) + + [ ENHANCEMENT ] + * GH #836: Support delayed (asynchronous) responses! + ("Delayed responses" in Dancer2::Manual for more information.) + (Sawyer X) + * GH #824: Use Plack::MIME by default, MIME::Types as failback if available. + (Alberto Simões) + * GH #792, #848: Keywords can now use prototypes. + (Russell Jenkins, Sawyer X) + + [ DOCUMENTATION ] + * GH #837, #838, #841: Major documentation restructure. (Snigdha Dagar) + (Check eb9416e9 and a78e27d7 for more details.) + * GH #823: Cleanup Manual and Cookbook docs. (Omar M. Othman) + * GH #828: Provide README.mkdn. (Nuno Carvalho) + * GH #830: Fix typo in Session::YAML pod. (Vince W) + * GH #831,#832: Fix broken link in Session::YAML pod. (Vince W) + +0.158000 2015-01-01 18:08:04+01:00 Europe/Amsterdam + + ** Happy new year! ** + + [ ENHANCEMENT ] + * GH #778: Avoid hard-coded static page location. (Dávid Kovács) + * Speed up big uploads significantly. (Rick Myers) + * GH #821: Use Import::Into to import pragmas. (Russell Jenkins) + * GH #782: Fix utf8 pragma import. (Maxim Vuets) + * GH #786: Perlbrew fix. (Dávid Kovács) + * GH #622: Refactoring. (James Raspass) + + [ DOCUMENTATION ] + * GH #713: Change order of statements in Cookbook to not imply that + D2::P::Ajax::ajax() calls have priority. (Sawyer X) + +0.157001 2014-12-21 20:40:13+01:00 Europe/Amsterdam + + [ ENHANCEMENT ] + * GH #814, #815: Rename "app.pl" to "app.psgi". (Sawyer X) + +0.157000 2014-12-14 18:23:33+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #799: Set current request earlier so log formats using requests + will work. (Sawyer X) + * GH #650: Provide default environment to app for templating. + (Dávid Kovács, Chi Trinh) + * GH #800: Better portability code, for different Windows situations. + (Christian Walde) + * Less littering of the test directories with session files. (Sawyer X) + + [ ENHANCEMENT ] + * GH #810: strict && warnings in the app.pl. (Sawyer X) + * Use to_app keyword in skeleton. (Sawyer X) + * GH #801: Under production, server tokens are disabled. (Sawyer X) + * GH #588, #779: Remove LWP::UserAgent in favor of HTTP::Tiny. + (Dávid Kovács, simbabque, Sawyer X) + * Remove all usages of Test::TCP in favor of Plack::Test. (Sawyer X) + + [ DOCUMENTATION ] + * GH #802: Remove indication of warnings configuration option + and add explanation in migration document. (Sawyer X) + * GH #806: Link in main docs to the migration document. (Gabor Szabo) + * GH #807: Update migration document with more session data, + changes to app.pl, and Template::Toolkit configuration. (Gabor Szabo) + * GH #813: Update migration document with information on encoding and + usage of Plack::Request internally. (Gabor Szabo, Sawyer X) + +0.156001 2014-12-08 23:03:43+01:00 Europe/Amsterdam + + [ DOCUMENTATION ] + * Documentations suggested serializers aren't consistent. We fixed it + so we make sure docs reflect that. (Sawyer X) + +0.156000 2014-12-07 18:04:14+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * Do not try to deserialize empty content. + (Lennart Hengstmengel, Sawyer X) + * Do not call serialization hooks when no serialization took place. + (Sawyer X) + * Be more cautious on undef output from serializer. + (Daniel Böhmer, Sawyer X) + + [ ENHANCEMENTS ] + * Add cpanfile when scaffolding a new app. + (Dávid Kovács, Sawyer X) + * Response "content" attribute no longer stringifies. This should help + reduce warnings, odd debugging problems, etc. (Sawyer X) + * DSL "uri_for" no longer returns URI object. Instead just the URI. + (Sawyer X) + + [ DOCUMENTATION ] + * GH #777: Fix doc for mentioning public dir. + (Dávid Kovács, Sawyer X) + * GH #787: Document all environment variables. (Sawyer X) + +0.155004 2014-12-04 11:51:23+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * Guard against content length being empty strings. This is really + bizarre case but saw it once. (Sawyer X) + +0.155003 2014-12-03 22:32:12+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #798: More test fixes on Windows. (A. Sinan Unur) + +0.155002 2014-12-02 22:59:32+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * Fix test on Windows. (A. Sinan Unur) + +0.155001 2014-11-28 17:42:24+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * Small typo in test. (Dávid Kovács) + +0.155000 2014-11-28 01:18:39+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #773, #775: AutoPage handler no longer renders layouts. + (Dávid Kovács, Sawyer X) + * GH #770: Prevent crazy race condition between the logger engine and + other engines. This means engines now call "log_cb" to log. + (Sawyer X) + * App now has default name to caller package. (Sawyer X) + * Serializers will not try to serialize empty content. (Sawyer X) + * Lots of cleanups in Core::Request in favor of Plack::Request. + (Sawyer X) + + [ ENHANCEMENTS ] + * Layouts directory can be configured using 'layout_dir'. + (Sawyer X) + * GH #648, #760: Logger format now supports 'h', 'u', 'U', 'h', 'i'. + They are documented but weren't really available. + (Lennart Hengstmengel) + * Serializers having errors will not fail if there is no logger. + (Sawyer X) + * Create a request object with a single argument of $env, like + Plack::Request. (Sawyer X) + + [ DOCUMENTATION ] + * Remove documented hack for static content because we use the middleware + now anyway. (Sawyer X) + * Document further the difference between splat and megasplat. + (Dávid Kovács) + +0.154000 2014-11-17 15:36:31+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #744: Serialize anything, not just references. (Sawyer X) + * GH #744: Serialize regardless of content_type of serializer. (Sawyer X) + * GH #764: Catch template render errors. (Russell Jenkins, Steven Humphrey) + * Calling uri_for(undef) doesn't crash. (Sawyer X) + * GH #732: Correct name for 403 (Forbidden, not Unauthorized). + (Theo van Hoesel, Sawyer X, Mickey Nasriachi, Omar M. Othman) + * GH #753: Syntax of parameterized types. (Russell Jenkins) + * GH #734: Failing tests on Windows. (Russell Jenkins, Sawyer X) + + [ ENHANCEMENTS ] + * GH #664, #684, #715: Handler::File replaced for static files with + Plack::Middleware::Static, allowing files to be served *before* routes. + This means hooks do not apply to static files anymore! + (Russell Jenkins, DavsX) + * Engines now have "logger" attribute to log errors. It sends the + Dancer2::Logger:: object, if one exists. (Sawyer X) + * Serializers do not need to implement "loaded" method. (Sawyer X) + * GH #733: In core: response_xxx removed in favor of generic + standard_response. (Sawyer X, Mickey Nasriachi, Omar M. Othman) + * GH #514, #642, #729: Allow mixing named params, splat, and + megasplat. (Russell Jenkins, Johan Spade, Dávid Kovács) + * GH #596: no_server_tokens works, as well as DANCER_NO_SERVER_TOKENS. + (Omar M. Othman, Sawyer X, Mickey Nasriachi) + * GH #639: Validate engine types in configuration. + (Sawyer X, Omar M. Othman, Mickey Nasriachi, Russell Jenkins) + * GH #663, #741: Remove "accept_type" attribute and other references. + (Mickey Nasriachi, Theo van Hoesel) + * GH #748: Provide forwarded_host, forwarded_protocol. (Sawyer X) + * GH #748: Do not provide a default env, require env for a request. + (Sawyer X) + * GH #742: Update test skeleton to use to_app. (Dávid Kovács) + * GH #636: Use Plack::Test in more tests. (Dávid Kovács) + + [ DOCUMENTATION ] + * GH #656: Dancer2::Manual::Testing as a guide for testing Dancer2 + applications. (Sawyer X) + * Improved documentation of route matching. (Russell Jenkins) + * Migration document update relating to enhancements. + (Sawyer X, Mickey Nasriachi) + * GH #731: Document changes in session. + (racke, Sawyer X, Mickey Nasriachi, Omar M. Othman) + * Document "id" attribute in Request object. (Sawyer X) + * Correct Cookbook examples on command line scripts. (Sawyer X) + +0.153002 2014-10-30 09:23:52+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #734: More failing tests. (Sawyer X) + +0.153001 2014-10-27 12:39:54+01:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #734: Failing tests on Windows. (Sawyer X) + + [ DOCUMENTATION ] + * GH #724: Plack::Test example in Dancer2::Test. (Jakob Voss) + +0.153000 2014-10-23 23:45:36+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #634, #687: Fix file logger defaults. + (Russell Jenkins, Dávid Kovács, Sawyer X) + * GH #730: Make App use app-level config for behind_proxy. (Sawyer X) + * GH #727: Disable regex metachars when calculating app location in tests + (Gregor Herrmann) + * GH #681, #682, #712: Clear session engine within destroy_session. + (DavX, Russell Jenkins) + * Ignore :tests in importing, don't suggest :script. (Sawyer X) + + [ ENHANCEMENT ] + * Internal: Move the implementation of send_file from DSL to App. + (Russell Jenkins) + + [ DOCUMENTATION ] + * GH #728: Typos in Policy document. (Olaf Alders, Sawyer X) + +0.152000 2014-10-14 04:30:59+02:00 Europe/Amsterdam + + [ BUG FIXES ] + * GH #723: Redispatched requests lose data. (Sawyer X) + + [ ENHANCEMENT ] + * Provide 'content' keyword to set the response content. (Sawyer x) + * GH #616, #155, #615: Session engines are now lazy! (Russell Jenkins) + * Dancer2 response objects can be created from arrays or from + Plack::Response objects. (Sawyer X) + * GH #718: Clean up App's Template engine. (Russell Jenkins) + * Adding class-based tests. (Sawyer X) + + [ DOCUMENTATION ] + * Add a policy document under Dancer2::Policy. (Sawyer X) + * Document log_format instead of logger_format. (Sawyer X) + +0.151000 2014-10-08 21:49:06+02:00 Europe/Amsterdam + + [ ENHANCEMENT ] + * Apps are now a proper independent PSGI application. Forwarding + and passing requests between apps will still work if you use the + 'Dancer2->psgi_app' method without providing a class, but it might + still be phased out in the future. + (Sawyer X) + + [ DOCUMENTATION ] + * Migration document! (Snigdha Dagar) + * GH #667: Fix typo in cookbook pod. (Lindsey Beesley) + * GH #649, #670: Document core logger. (simbabque) + * GH #689: Git guide markdown fixes. (Paul Cochrane) + * GH #690, #691, #694, #696, #698, #699, #700, #702, #703, + #704, #705, #706, #707, #708, #710: Doc cleanups. + (Paul Cochrane) + * GH #688: Improve testing documentation. (Paul Chochrane) + * GH #692: Document serving static files using + Plack::Middleware::Static. (Dávid Kovács @DavsX) + * GH #695: Correct Dancer2::Logger::Capture, add test example. + (Dávid Kovács @DavsX) + * GH #716: Correct document on proxy procotol forwarding + in Apache. (Andy Beverley) + +0.150000 2014-08-17 01:35:16CEST+0200 Europe/Amsterdam + + [ DOCUMENTATION ] + * GH #657: Update multi-app example in cookbook to include route + merging. (Bas Bloemsaat) + * GH #643: Improve session factory docs by mentioning Dancer2::Config. + (Andy Jack) + + [ BUG FIXES ] + * Postponed hooks are no longer sent to all Apps. + (Sawyer X, Mickey Nasriachi) + * 404 File Not Found Application reworked to stay up to date with + postponed hooks merging in multiple apps. (Russell Jenkins) + * GH #610, #662: Removed two circular references memory leaks! + (Russell Jenkins) + * GH #633: Log an error when a hook dies. (DavsX) + + [ ENHANCEMENT ] + * Allow settings apps in the psgi_app() call by name or regex. + (Sawyer X) + * GH #651: silly typo in clearer method name (DavsX). + +0.149000_02 2014-08-10 13:50:39CEST+0200 Europe/Amsterdam + + [ ENHANCEMENT ] + * GH #641: Adding a shim layer to prevent available hooks (and + thus plugins) from breaking. + * Each App can now define its own configuration. The Runner's + application-specific configure has been untangled. + (Russell @veryrusty Jenkins, Sawyer X, Mickey Nasriachi) + * Multiple Dancer App support. You can now create a App-specific + PSGI application using MyApp->psgi_app. + (Russell @veryrusty Jenkins, Sawyer X, Mickey Nasriachi) + * Add routes and hooks to an existing app on import. + (Russell @veryrusty Jenkins, Stevan Humphrey, Stefan racke + Hornburg, Jean Stebens, Chunzi, Sawyer X, Mickey Nasriachi) + * Allow DSL class to be specified in configuration file. + (Stevan Humphrey) + * forward() now returns a new request which is then just runs + the dispatching loop again. (Sawyer X, Mickey Nasriachi) + + [ BUG FIXES ] + * GH #336: Set log level correctly. + (Andrew Solomon, Pedro Bruno) + * GH #627, #607: Remove potential context issues with returning + undef explicitly. (Javier Rojas) + * GH #646: Fix whitespacing for tests. (DavsX) + +0.149000_01 2014-07-23 21:31:21CEST+0200 Europe/Amsterdam + + *************************** NOTICE *************************** + * This very is a major upgrade * + * We untangled the context, DSL implementation a bit * + * Please check your code, including your plugins, thoroughly * + * Thank you * + + [ ENHANCEMENTS ] + * GH #589: Removing Dancer2::Core::Context global context variable. + Finally in. + (Sawyer X, Mickey Nasriachi, Russell @veryrusty Jenkins) + + [ BUG FIXES ] + * GH #606, #605: Fix for setting public directory. + (Ivan Kocienski, Russell Jenkins, Stefan @racke Hornburg) + * GH #618, #620: Fix jQuery link generated by CLI skeleton. + (Michał Wojciechowski) + * GH #589: Major memory leak fix by removal of Dancer2::Core::Context. + + [ ENHANCEMENTS ] + * GH #620: Bump jQuery to 1.11.1. (Michał Wojciechowski) + +0.143000 2014-07-05 21:39:28CEST+0200 Europe/Amsterdam + + [ BUG FIXES ] + * GH #538, #539: Coerce propogated exceptions to strings within Error object. + (Steven Humphrey) + * GH #531: Generate valid HTML when show_errors is true from Error objects. + (Steven Humphrey) + * GH #603: Update skeleton test to use Plack::Test. (Sawyer X) + + [ ENHANCEMENTS ] + * Provide psgi_app in top-level Dancer.pm to make it easier to change it. + (Sawyer X) + +0.142000 2014-06-24 15:16:42CEST+0200 Europe/Amsterdam + + [ BUG FIXES ] + * GH #550, #555: Allow the content type to be set when using send_file + as per the documentation. (Russell Jenkins, Steven Humphrey) + + [ ENHANCEMENTS ] + * GH #512, #520, #602: Pass all settings into JSON serializer engine. + (Jakob Voss, Russell Jenkins) + * GH #532: Serialize runtime errors such as those produced by die if a + serializer exists. (Steven Humphrey) + +0.141000 2014-06-08 22:27:03CEST+0200 Europe/Amsterdam + + * No functional changes. + +0.140900_01 2014-06-07 23:32:56IDT+0300 Asia/Jerusalem + + [ BUG FIXES ] + * GH #447: Setting the apphandler now triggers the Dancer Runner + configuration change, which works. (Sawyer X) + * GH #578: Remove the default engine configurations. (Sawyer X) + * GH #567: Check for proper module names in loading engines. Might help + with taint mode. (Sawyer X) + * GH #585, #595: Return 405 Method Not Allowed instead of 500. + (Omar M. Othman) + * GH #570, #579: Ensure keywords pass, send_error and send_file + exit immediately when executed. (Russell Jenkins) + + [ ENHANCEMENTS ] + * GH #587: Serializer::Mutable alive! (Pedro Bruno) + + [ DOCUMENTATION ] + * Fix doc for params(). Ported from Dancer#1025 (Stefan Hornburg) + +0.140001 2014-05-01 10:49:25CEST+0200 Europe/Amsterdam + + [ BUG FIXES ] + * Bugfix for extracting multiple cookies within a request. + (Cymon, Russell Jenkins) + * Require minimum version of Plack to make sure we can add the Head + middleware. Not exactly a bug, but not a feature. (Sawyer X) + + [ DOCUMENTATION ] + * Correct reference to HTTP::Server::Simple::PSGI. (Russell Jenkins) + +0.140000 2014-04-28 23:14:31CEST+0200 Europe/Amsterdam + + [ ENHANCEMENTS ] + * Replace Config role with better ConfigReader role. + (Mickey Nasriachi, Stefan Hornburg, Sawyer X) + * Move App-related attributes (engines) to App instead of config role. + (Mickey Nasriachi, Stefan Hornburg, Sawyer X) + * Untangle Runner-Server (removing Server entirely). + (Mickey Nasriachi, Stefan Hornburg, Sawyer X) + * Replace HTTP::Server::Simple::PSGI with HTTP::Server::PSGI. + (Mickey Nasriachi, Stefan Hornburg, Sawyer X) + * GH #527: Build request cookie objects from request headers, not env. + (Russell Jenkins) + * GH #569: Transform cookie using the HTTP_COOKIE header, per PSGI spec. + (Russell Jenkins) + * GH #559, #544: Use Plack middleware for HEAD request content removal. + (Russell Jenkins) + * GH #513, #483: Deserialize body content for DELETE requests. + (Russell Jenkins, Yanick Champoux, Sawyer X) + +0.13 2014-04-13 19:19:44CEST+0200 Europe/Amsterdam + + [ ENHANCEMENTS ] + * GH #562: Change YAML::Any to YAML (Steven Humphrey, Russell Jenkins). + + [ BUG FIXES ] + * GH #524: Double encoding for YAML sessions. + * GH #557: Switch to using YAML::Old. + * GH #548: Deserializer test failure. + +0.12 2014-04-07 22:42:12 Europe/Amsterdam + + [ ENHANCEMENTS ] + * GH#518: Bump jQuery to 1.10.2 (Grzegorz Rożniecki). + * GH#535: Support OPTIONS and PATCH requests in Server::Standalone. + (Russell Jenkins) + * GH#553: Dancer2 CLI: specify directory to write app skeleton + (Jean Stebens) + * GH#543: Additional HTTP Methods for Ajax plugin (Jean Stebens). + + [ DOCUMENTATION ] + * RT#91428: POD encoding set to UTF-8 in main .pm (Gregor Herrmann). + * GH#517: Miscellaneous documentation fixes (Cesare Gargano). + * GH#518: "Getting started" demo page fixes (Grzegorz Rożniecki). + * GH#522: s/PerlHandler/PerlResponseHandler/ in Apache2 sample configuration + (Grzegorz Rożniecki) + * GH#521: Remove duplicated POD and clean up list details (Shlomi Fish) + * GH#526: Cleanup POD formating and code snippets in manual. + (Grzegorz Rożniecki) + + [ BUG FIXES ] + * GH#528,529: Force PSGI server in dispatch scripts for CGI or fcgi + deployments (Erik Smit, Alberto Simões) + * GH#550,GH#551: Update all headers in Handler::File + (Sawyer X, Stefan @racke Hornburg) + * GH#540: Fix hook execution when default scalar was used in hook code. + (baynes, Russell Jenkins) + * GH#552: Rework test suite to use Plack::Test + (Sawyer X, Stefan @racke Hornburg) + * GH#560: Return value of hooks do not alter response content. + (Jean Stebens) + +0.11 2013-12-15 14:19:22 Europe/Amsterdam + + [ ENHANCEMENTS ] + * GH#481: Don't pollute @INC automatically when Dancer2 is imported, each + runner is now responsible of including the local ./lib dir if needed. + * GH#469, 418: Dancer2::Plugin provides a ':no_dsl' flag for modern Plugins + (Pedro Melo) + * GH#485: Keywords 'redirect' and 'forward' exit immediately when executed in + a route/hook. New dependency on Return::MultiLevel (Russell Jenkins). + * GH#495: Use accessor and predicates instead of direct access. + Addresses GH#493 too. (Russell Jenkins) + * GH#502,GH#472: Rework halt to use with_return from Return::MultiLevel. + (Russell Jenkins) + * GH#479,GH#480,GH#508: Pass parameters to params() in the DSL. + (Slava Goltser, unickuity, Russell Jenkins) + * GH#505: Fix empty HTTP_REFERER in Dancer::Core::Request (Menno Blom). + * GH#503: Multiple reverse proxy support (Menno Blom). + * GH#371,GH#506: CLI tool rewrite (using App::Cmd, supports plugins, etc.). + (Ivan Kruglov, Samit Badle, Sawyer X) + * GH#498: Add some missing items in MANIFEST.SKIP (Gabor Szabo, Sawyer X). + + [ DOCUMENTATION ] + * GH#489: Remove link to Dancer2::Deployment pod which does not exist + (Sweet-kid) + * GH#511: s/Deflator/Deflater/; (Cesare Gargano) + * GH#491: Updated config paths for template_toolkit in cookbook. + (Mark A. Stratman) + * GH#494: Update session config details (Dancer2::Config), + namespace fixup in Dancer2::Core::cookie. + (Russell Jenkins) + * GH#470: Fix Plack::Builder mount usage (Pedro Melo). + * GH#507: Fix plenty of typos (David Steinbrunner). + * GH#477: Document problem with Plack Shotgun on Windows (Ahmad M. Zawawi). + * GH#504: Add link to Dancer2::Plugin::Sixpack (Menno Blom). + * GH#490: Document Dancer2 should be FatPackable (Sawyer X). + * GH#452: Make a complete authors section, clean it up (Pau Amma). + * More fixes to main documentation (Pau Amma). + +0.10 2013-09-28 15:26:41 Europe/Paris + + [ DOCUMENTATION ] + * GH#431: Miscellaneous documentation fixes (Gideon D'souza) + * Small POD corrections (Ashvini V) + + [ ENHANCEMENTS ] + * GH#482: Show the startup banner when the worker starts by default + (Alexis Sukrieh). + * GH#481: Include local lib dir in @INC by defaults (Alexis Sukrieh). + * GH#423: Remove ':tests' from Dancer.pm import (Alberto Simões). + * GH#422: Get rid of core_debug method (Alberto Simões). + * GH#421: Support Plugin::Ajax content_type (Russell Jenkins). + * GH#428: Make default errors CSS path relocatable (Russell Jenkins). + * GH#427, GH#443: Replace global warnings with lexical (Russell Jenkins). + * GH#374: Don't create an app from app.psgi (Alberto Simões). + * Cleanup Core::Request, Core::Request::Upload (Mickey Nasriachi). + * GH#445: Test Template::Simple (Alexis Sukrieh, Russell Jenkins). + * GH#449: Test Session hooks (Gideon D'souza) + * GH#434,440: Imutable attributes (Mickey Nasriachi). + * GH#435: Allow send_error to serialize error (Russell Jenkins). + * Add more tests to session id rw (Pedro Melo). + * Whitespace cleanup (Ivan Bessarabov). + + [ BUG FIXES ] + * GH#424,425: Fix logger tests for different timezones, and close + logfile before deleting it: Windows dixit. + (Gideon D'souza, Russell Jenkins) + +0.09 2013-09-02 00:12:58 Asia/Jerusalem + + [ ENHANCEMENTS ] + * Rewite DSL keyword engine (Mickey Nasriachi) + * Require minimum Role::Tiny 1.003000 (Alberto Simões) + * GH#382: Move Request attributes to params, and fix serializers + behavior (Russell Jenkins) + * GH#406: Replace Dancer2::ModuleLoader with Class::Load + (Alberto Simões, Sawyer X) + * GH#329: Remove 'load_app' DSL keyword. Remove reference to + 'load' as well. (Sawyer X) + * GH#412: Autopages are now called properly with correct MIME. + (Alberto Simões) + + [ DOCUMENTATION ] + * GH#390: minor cookbook documentation fixes (Russell Jenkins) + * GH#392: remove support to auto_reload and suggest alternative + in Dancer2::Cookbook (Ahmad M. Zawawi) + * GH#397,407: Miscellaneous documentation fixes (Andrew Solomon) + * Documentation cleanups (Alex Beamish) + + [ BUG FIXES ] + * When compiling route regex object with prefix, add the closing anchor + (Mickey Nasriachi) + * GH#386: honor log level defined in config file (Alberto Simões) + * GH#396,409: Miscellaneous bug fixes (Russell Jenkins) + * GH#403: Fix forward behavior (Russell Jenkins) + +0.08 2013-08-18 15:22:45 Asia/Jerusalem + + [ ENHANCEMENTS ] + * GH#352: Define content_type as a property for serializers. (Franck Cuny) + * Cleanup duplicate HTTP status code between Core::Error and Core::HTTP + (Russel Jenkins) + * GH#363: Move core methods to Dancer2::Core (Alberto Simões) + * GH#362: Serializers documentation and test cleanup. (Franck Cuny) + * Refactoring of the engine method. (Franck Cuny) + * Misc. code cleanup. (Russel Jenkins) + * GH#280: Remove the unused ':syntax' importing tag (Sawyer X) + * Display startup info only if environment is "development" (Franck Cuny) + * Move postponed_hooks to server from runner (Sawyer X) + * Provide easier access to global runner (Sawyer X) + * Bunch of code cleanups which also includes speed boost (Sawyer X) + * More immutability in the runner class and config role (Sawyer X) + + [ BUG FIXES ] + * GH#85, GH#354: Fix autopages, especially in subdirs + (Stefan Hornburg, Alberto Simões) + * GH#365: Fix serializer settings (Steven Humphrey) + * GH#333: callerstack for logger was too short (Alberto Simões) + * GH#369: Move request deserialization from Dispatcher to Content & Request + (Russell Jenkins) + + [ DOCUMENTATION ] + * GH#192: Documentation the current usage of middlewares using + Plack::Builder (Sawyer X) + * GH#195, GH#197, GH#372: Multiple apps with Plack::Builder (Sawyer X) + * GH#348: Documentation of Role::Logger (Franck Cuny) + * GH#350: Move part of README.md to GitGuide.md (Franck Cuny) + * GH#353: Documentation of Role::Serializer (Alberto Simões, Franck Cuny) + * Misc. minor documentation tweak (Alberto Simões, Franck Cuny) + +0.07 2013-08-04 01:14:59 Asia/Jerusalem + + [ ENHANCEMENTS ] + * GH#344, GH#284: Now forward() calls preserve sessions (cym0n, Alberto Simões) + * Separation of engines from triggers and configuration (Sawyer X, Franck Cuny) + * GH#347: Remove old compatibility option 'log_path' (Franck Cuny) + * GH#156, GH#250, GH#349: Remove unused module (Alberto Simões, mokko) + * GH#331: Hook cleanups and documentation. (Franck Cuny) + * GH#335: Serializing cleanup. (Franck Cuny) + * GH#332: Clean up multiple definitions of core_debug (Franck Cuny) + * GH#338: Clean up route builder (Mickey Nasriachi) + * Clean up of the dzil configuration (Alberto Simões) + + [ BUG FIXES ] + * GH#334: Fix for GH#86, to display custom 500 page/template on + internal server errors (Russell Jenkins) + * GH#346: Fix tests on 5.8.9 (Albert Simões) + + [ DOCUMENTATION ] + * GH#345: Documentation reorganization (Alberto Simões, Franck Cuny) + +0.06 2013-07-30 (Sawyer X) + + [ ENHANCEMENTS ] + * Clean up of the dzil configuration (Alberto Simões,Franck Cuny, Russel Jenkins) + * GH#327: Add support for 'info' log level (Russell Jenkins) + * Remove 'for_versions' usage from tests (Alberto Simões) + + [ BUG FIXES ] + * GH#326, GH#232: don't end up with empty views and layout (Franck Cuny) + * GH#325: don't die or complain when two routes have the same path (Franck Cuny) + * GH#320: fix plugin_setting deprecation warning (David Golden) + + [ DOCUMENTATION ] + * POD cleanup (Sawyer X, Franck Cuny) + +0.05 2013-07-20 18:51:53 Europe/Paris + + [ DEPRECATION ] + + * Dancer2::Plugin drops support for Dancer 1 (issue #207) + a DEPRECATION notice is issued when a plugin uses the old syntax + (Alexis Sukrieh, Mokko, David Golden) + * Drop support for 'use Dancer2 :moose' (Franck Cuny) + + [ ENHANCEMENTS ] + * Add support for HTTP_X_FORWARDED_PROTO (Yanick Champoux) + * Don't inflate custom types (Graham Knop) + * Encode UTF8 params in Dancer2::Test (Vincent Bachelier) + * Make Dancer2::Core::Request more lazy (Franck Cuny) + * Don't use rootdir for app location (David Golden) + * Improve File logger (David Golden) + * Drop body when status is 1x or [23]04 (Franck Cuny) + * Add support for HTTP_X_FORWARDED_PROTO (Yanick Champoux) + * Prevent duplicate routes from being created (Franck Cuny) + * Add support for route options (Franck Cuny) + * Add support for prefix with route defined with regex (Franck Cuny) + * Methods to return path of views and layout in the Template role + (Franck Cuny, Yanick Champoux). + * GH#31, GH#221: Config merging support (Russell Jenkins) + + [ BUG FIXES ] + * GH#272: test function 'route_doesnt_exist' was not handling test comment + properly. (Jeff Boes, Yanick Champoux) + * GH#228: handle UTF-8 correctly in JSON serializer (Steven Humphrey) + * GH#270: handle correctly serializer's options (Keith Broughton) + * GH#274: `dancer -v' returns the correct version (Dinis Rebolo) + * GH#286: for HEAD request, drop response's body (Franck Cuny) + * GH#293: fix defaults tests for a newly generated app (Franck Cuny) + * GH#216: check 'show_errors' when returning an internal error (Franck Cuny) + * GH#246: Add serialization of log messages (Stefan Hornburg) + * GH#268: Dancer2::Core::Response->status accepts stringy HTTP codes + (Franck Cuny) + * GH#308: Add support for ENV{DANCER_CONFDIR} and ENV{DANCER_ENVDIR} + (Franck Cuny) + * GH#210: Don't print startup banner if startup_info is set to 0 + (Maurice Mengel, Franck Cuny) + * plugin_setting does not trigger a DEPRECATION warning anymore + (Report by Alberto Simões, fix by Alexis Sukrieh) + * GH#251: Support for on-the-fly changes of layouts/views (Franck Cuny) + * GH#302: Avoid double encoding in Handler::File (Russell Jenkins) + + [ DOCUMENTATION ] + * Lots of documentation cleanup (Mokko, David Precious) + * Documenting Dancer2::Handler::AutoPage (Sabiha Imran, Sawyer X) + * Documenting Dancer2::Core::Dispatcher (Babitha Balachandran) + * Documenting Dancer2::Manual::DSL (David Precious, Franck Cuny) + * Various typo (Shlomi Fish, Colin Kuskie, Stefan Hornburg, Rick Yakubowski) + * Documenting some internals (Colin Kuskie) + * Documenting Dancer2::Core::MIME (Babitha B.) + * Documenting Manual::Developers (Maurice Mengel) + * Documenting Dancer2::Core::Response (Colin Kuskie) + +0.04 - 2013-04-22 (Alexis Sukrieh) + + [ BUG FIXES ] + * Fix "Internal Sever Error" when sending a file with send_file + (Dinis Rebolo) + * Allow the setting of the 'views' directory, like stated in documentation + (Alexander Karelas) + + [ ENHANCEMENTS ] + * Implement Dancer2::Test file uploads (Steven Humphrey) + * Give Dancer2::Test the ability to handle multiselect inputs + (Steven Humphrey) + * Make Cookie objects stringify to their value. (David Precious) + * New routines for Dancer2::Test to check pod coverage in apps routes + (Dinis Rebolo) + * New script dancer2 to bootstrap an application (mokko) + * Fix tests when running under Windows environments (Russell Jenkins) + * Serializing modify the response's content type (Yanick Champoux) + + [ DOCUMENTATION ] + * Make introduction more fluid in Dancer2's POD. (mokko) + + [ PACKAGING ] + * Remove prereq Digest::SHA (mokko) + * Dancer::P::Bcrypt recommends Dancer::P::Passphrase (Blabos de Blebe) + +0.03 - 2013-03-07 (Alexis Sukrieh) + + [ ENHANCEMENTS ] + * Don't create a session when just checking if a value exists + (David Golden) + * Only flush sessions if they are dirty + (David Golden) + * Allow the default template file extension to be changed. + (David Precious) + * Add on_plugin_import function to Dancer2::Plugin (David Golden) + (Fix for issue #284) + + [BUG FIXES] + * Dancer2::ModuleLoader now use Module::Runtime at its core + (issue #166, Yanick Champoux) + + [ DOCUMENTATION ] + * changed <% to [% in documentations (Alexander Karelas) + * Improve Dancer2::Plugin documentation (David Golden) + +0.02 - 2013-02-24 (Alexis Sukrieh) + + [ DOCUMENTATION ] + * No more "TODO" tokens in the documentations + * More documentation for Core classes + (Alexis Sukrieh) + + [ ENHANCEMENTS ] + * Removed the "api_version" code that is useless and was breaking some + tests. + (Alexis Sukrieh) + +0.01 + + [ ENHANCEMENTS ] + * Dancer::Test takes a hash instead of an array for better backward + compatibility with Dancer 1. + (Celogeek) + * Session revamp: better decoupling between Session and SessionFactory, + support for session destruction and session values deletion. Everythin + regarding session settings is now configurable. + (David Golden). + * Add route_exists and route_doesnt_exist in Dancer::Test (Mokko) + * session cookie duration can be expressed with human readable strings + * instead of numeric values (Alexis Sukrieh, issue #157). + + [ BUG FIXES ] + * The engine configuration is now passed down to + Dancer::Template::Implementation::ForkedTiny (Damien Krotkine). + * Dancer App lookup now try to detect the dir "bin" and "lib" or ".dancer" + file. (Celogeek) + * Issues #125 and #126 + Support for configuration bits for session objects, possible to change the + cookie name instead of the hard-coded value 'dancer.session'. + (Reported by David Golden, fixed by Alexis Sukrieh). + + [ DOCUMENTATION ] + * Add more POD in Dancer::Test (Mokko) + +1.9999_02 + + * Fix tests for previous release, tests cannot assume we're under Dancer 2 + when the version is 1.9999 + (Alexis Sukrieh) + +1.9999_01 + + * First DEVELEOPER release of Dancer 2 + complete rewrite of Dancer with a Moo backend. + (Alexis Sukrieh, David Precious, Damien Krotkine, SawyerX, Yanick Champoux + and others, plus Matt S. Trout as a reviewer). diff --git a/GitGuide.md b/GitGuide.md new file mode 100644 index 00000000..4088b79a --- /dev/null +++ b/GitGuide.md @@ -0,0 +1,270 @@ +# Git Guide + +This guide will help you to set up your environment to be able to work +on the Dancer2's repository. + +## Contributing + +This guide has been written to help anyone interested in contributing +to the development of Dancer2. + +First of all - thank you for your interest in the project! It's the +community of helpful contributors who've helped Dancer grow +phenomenally. Without the community we wouldn't be where we are today! + +Please read this guide before contributing to Dancer2, to avoid wasted +effort and maximizing the chances of your contributions being used. + +There are many ways to contribute to the project. Dancer2 is a young +yet active project and any kind of help is very much appreciated! + +### Documentation + +We value documentation very much, but it's difficult to keep it +up-to-date. If you find a typo or an error in the documentation +please do let us know - ideally by submitting a patch (pull request) +with your fix or suggestion (see +[Patch Submission](#environment-and-patch-submission)). + +### Code + +You can write extensions (plugins) for Dancer2 extending core +functionality or contribute to Dancer2's core code, see +[Patch Submission](#environment-and-patch-submission) below. + +## General Development Guidelines + +This section lists high-level recommendations for developing Dancer2, +for more detailed guidelines, see [Coding Guidelines](#coding-guidelines) +below. + +### Quality Assurance + +Dancer2 should be able to install for all Perl versions since 5.8, on +any platform for which Perl exists. We focus mainly on GNU/Linux (any +distribution), \*BSD and Windows (native and Cygwin). + +We should avoid regressions as much as possible and keep backwards +compatibility in mind when refactoring. Stable releases should not +break functionality and new releases should provide an upgrade path +and upgrade tips such as warning the user about deprecated +functionality. + +### Quality Supervision + +We can measure our quality using the +[CPAN testers platform](http://www.cpantesters.org). + +A good way to help the project is to find a failing build log on the +[CPAN testers](http://www.cpantesters.org/distro/D/Dancer2.html). + +If you find a failing test report, feel free to report it as a +[GitHub issue](http://github.com/PerlDancer/Dancer2/issues). + +### Reporting Bugs + +We prefer to have all our bug reports on GitHub, in the +[issues section](http://github.com/PerlDancer/Dancer2/issues). + +Please make sure the bug you're reporting does not yet exist. If in doubt +please ask on IRC. + +## Environment and Patch Submission + +### Set up a development environment + +If you want to submit a patch for Dancer2, you need git and very +likely also [_Dist::Zilla_](https://metacpan.org/module/Dist::Zilla). +We also recommend perlbrew (see below) or, +alternatively, [_App::Plenv_](https://github.com/tokuhirom/plenv)) +to test and develop Dancer2 on a recent +version of Perl. We also suggest +[_App::cpanminus_](https://metacpan.org/module/App::cpanminus) +to quickly and comfortably install Perl modules. + +In the following sections we provide tips for the installation of some +of these tools together with Dancer. Please also see the documentation +that comes with these tools for more info. + +#### Perlbrew tips (Optional) + +Install perlbrew for example with + + $ cpanm App::perlbrew + +Check which Perls are available + + $ perlbrew available + +It should list the available Perl versions, like this (incomplete) list: + + perl-5.17.1 + perl-5.16.0 + perl-5.14.2 + perl-5.12.4 + ... + +Now run the init command for perlbrew. The init command initializes and controls +processes. The init command is run as the last step of any startup +process. + + $ perlbrew init + + +Then install a version inside perlbrew. We recommend you +give a name to the installation (`--as` option), as well as compiling +without the tests (`--n` option) to speed it up. + + $ perlbrew install -n perl-5.14.4 --as dancer_development -j 3 + +Wait a while, and it should be done. Switch to your new Perl with: + + $ perlbrew switch dancer_development + +Now you are using the fresh Perl, you can check it with: + + $ which perl + +Install cpanm on your brewed version of Perl. + + $ perlbrew install-cpanm + + +### Install various dependencies (required) + +Install Dist::Zilla + + $ cpanm Dist::Zilla + +### Get Dancer2 sources + +Get the Dancer sources from github (for a more complete git workflow +see below): + +Clone your fork to have a local copy using the following command: + + $ git clone git://github.com/perldancer/Dancer2.git + +The Dancer2 sources come with a `dist.ini`. That's the configuration +file for _Dist::Zilla_, so that it knows how to build Dancer2. Let's +use dist.ini to install additional `Dist::Zilla` plugins which are +not yet installed on your system (or Perl installation): + + $ dzil authordeps | cpanm -n + +That should install a bunch of stuff. Now that _Dist::Zilla_ is up and +running, you should install the dependencies required by Dancer2: + + $ dzil listdeps | cpanm -n + +When that is done, you're good to go! You can use `dzil` to build and test +Dancer2: + + $ dzil build + $ dzil test --no-author + + +### Running your modified version + +If you have any version of Dancer2 installed on your system you will likely +run into problems when you try and run the "Dancer2" binary due to the wrong +lib's being used. +The following command should resolve that. +```bash +perl -Ilib script/dancer2 gen -s share/skel --overwrite --path /tmp/d2app -a MyApp::App +``` +- It assumes we are in the git repo root dir +- `-Ilib` - tells perl to include the lib dir in it's search path +- in this case we run "gen" and + - `-s share/skel` - specify the use of the local copy of the skel dir + - `--overwrite` - we want to overwrite the generated scaffold project + - `--path /tmp/d2app` - the dir to write the generated scaffold project dir to + - `-a MyApp::App` - the name of the app project we want to generate + + +### Patch Submission (Github workflow) + +The Dancer2 development team uses GitHub to collaborate. We greatly +appreciate contributions submitted via GitHub, as it makes tracking +these contributions and applying them much, much easier. This gives +your contribution a much better chance of being integrated into +Dancer2 quickly! + +**NOTE:** All active development is performed in the _master_ branch. +Therefore, all your contribution work should be done in a fork of the +_master_ branch. + +Here is the workflow for submitting a patch: + +1. Fork the repository: http://github.com/PerlDancer/Dancer2 and click "Fork"; + +2. Clone your fork to have a local copy using the following command: + + $ git clone git://github.com/myname/Dancer2.git + +3. As a contributor, you should **always** work on the `master` branch of + your clone. + + $ git remote add upstream https://github.com/PerlDancer/Dancer2.git + $ git fetch upstream + + This will create a local branch in your clone named _master_ and + that will track the official _master_ branch. That way, if you have + more or less commits than the upstream repo, you'll be immediately + notified by git. + +4. You want to isolate all your commits in a _topic_ branch, this + will make the reviewing much easier for the core team and will + allow you to continue working on your clone without worrying about + different commits mixing together. + + To do that, first create a local branch to build your pull request: + + # you should be in master here + $ git checkout -b pr/$name + + Now you have created a local branch named _pr/$name_ where _$name_ + is the name you want (it should describe the purpose of the pull + request you're preparing). + + In that branch, do all the commits you need (the more the better) + and when done, push the branch to your fork: + + # ... commits ... + git push origin pr/$name + + You are now ready to send a pull request. + +5. Send a _pull request_ via the GitHub interface. Make sure your pull + request is based on the _pr/$name_ branch you've just pushed, so + that it incorporates the appropriate commits only. + + It's also a good idea to summarize your work in a report sent to + the users' mailing list (see below), in order to make sure the team + is aware of it. + + You could also notify the core team on IRC, on `irc.perl.org`, + channel `#dancer` or via [web client](http://www.perldancer.org/irc). + +6. When the core team reviews your pull request, it will either accept + (and then merge into _master_) or refuse your request. + + If it's refused, try to understand the reasons explained by the + team for the denial. Most of the time, communicating with the core + team is enough to understand what the mistake was. Above all, + please don't be offended. + + If your pull request is merged into _master_, then all you have to + do is remove your local and remote _pr/$name_ branch: + + $ git checkout master + $ git branch -D pr/$name + $ git push origin :pr/$name + + And then, of course, you need to sync your local devel branch with + upstream: + + $ git pull upstream master + $ git push origin master + + You're now ready to start working on a new pull request! diff --git a/LICENSE b/LICENSE new file mode 100644 index 00000000..b370564a --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 2019 by Alexis Sukrieh. + +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) 2019 by Alexis Sukrieh. + +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. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + 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. + + <signature of Ty Coon>, 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) 2019 by Alexis Sukrieh. + +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 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 00000000..92e2a319 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,387 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. +AUTHORS +Changes +GitGuide.md +LICENSE +MANIFEST +META.json +META.yml +Makefile.PL +cpanfile +examples/single/hello_world.psgi +examples/single/simple_calculator.psgi +lib/Dancer2.pm +lib/Dancer2/CLI.pm +lib/Dancer2/CLI/Command/gen.pm +lib/Dancer2/CLI/Command/version.pm +lib/Dancer2/Config.pod +lib/Dancer2/Cookbook.pod +lib/Dancer2/Core.pm +lib/Dancer2/Core/App.pm +lib/Dancer2/Core/Cookie.pm +lib/Dancer2/Core/DSL.pm +lib/Dancer2/Core/Dispatcher.pm +lib/Dancer2/Core/Error.pm +lib/Dancer2/Core/Factory.pm +lib/Dancer2/Core/HTTP.pm +lib/Dancer2/Core/Hook.pm +lib/Dancer2/Core/MIME.pm +lib/Dancer2/Core/Request.pm +lib/Dancer2/Core/Request/Upload.pm +lib/Dancer2/Core/Response.pm +lib/Dancer2/Core/Response/Delayed.pm +lib/Dancer2/Core/Role/ConfigReader.pm +lib/Dancer2/Core/Role/DSL.pm +lib/Dancer2/Core/Role/Engine.pm +lib/Dancer2/Core/Role/Handler.pm +lib/Dancer2/Core/Role/HasLocation.pm +lib/Dancer2/Core/Role/Hookable.pm +lib/Dancer2/Core/Role/Logger.pm +lib/Dancer2/Core/Role/Serializer.pm +lib/Dancer2/Core/Role/SessionFactory.pm +lib/Dancer2/Core/Role/SessionFactory/File.pm +lib/Dancer2/Core/Role/StandardResponses.pm +lib/Dancer2/Core/Role/Template.pm +lib/Dancer2/Core/Route.pm +lib/Dancer2/Core/Runner.pm +lib/Dancer2/Core/Session.pm +lib/Dancer2/Core/Time.pm +lib/Dancer2/Core/Types.pm +lib/Dancer2/FileUtils.pm +lib/Dancer2/Handler/AutoPage.pm +lib/Dancer2/Handler/File.pm +lib/Dancer2/Logger/Capture.pm +lib/Dancer2/Logger/Capture/Trap.pm +lib/Dancer2/Logger/Console.pm +lib/Dancer2/Logger/Diag.pm +lib/Dancer2/Logger/File.pm +lib/Dancer2/Logger/Note.pm +lib/Dancer2/Logger/Null.pm +lib/Dancer2/Manual.pod +lib/Dancer2/Manual/Deployment.pod +lib/Dancer2/Manual/Migration.pod +lib/Dancer2/Manual/Testing.pod +lib/Dancer2/Plugin.pm +lib/Dancer2/Plugins.pod +lib/Dancer2/Policy.pod +lib/Dancer2/Serializer/Dumper.pm +lib/Dancer2/Serializer/JSON.pm +lib/Dancer2/Serializer/Mutable.pm +lib/Dancer2/Serializer/YAML.pm +lib/Dancer2/Session/Simple.pm +lib/Dancer2/Session/YAML.pm +lib/Dancer2/Template/Implementation/ForkedTiny.pm +lib/Dancer2/Template/Simple.pm +lib/Dancer2/Template/TemplateToolkit.pm +lib/Dancer2/Template/Tiny.pm +lib/Dancer2/Test.pm +lib/Dancer2/Tutorial.pod +script/dancer2 +share/skel/.dancer +share/skel/MANIFEST.SKIP +share/skel/Makefile.PL +share/skel/bin/+app.psgi +share/skel/config.yml +share/skel/cpanfile +share/skel/environments/development.yml +share/skel/environments/production.yml +share/skel/lib/AppFile.pm +share/skel/public/+dispatch.cgi +share/skel/public/+dispatch.fcgi +share/skel/public/404.html +share/skel/public/500.html +share/skel/public/css/error.css +share/skel/public/css/style.css +share/skel/public/favicon.ico +share/skel/public/images/perldancer-bg.jpg +share/skel/public/images/perldancer.jpg +share/skel/public/javascripts/jquery.js +share/skel/t/001_base.t +share/skel/t/002_index_route.t +share/skel/views/index.tt +share/skel/views/layouts/main.tt +t/00-compile.t +t/00-report-prereqs.dd +t/00-report-prereqs.t +t/app.t +t/app/t1/bin/app.psgi +t/app/t1/config.yml +t/app/t1/lib/App1.pm +t/app/t1/lib/Sub/App2.pm +t/app/t2/.dancer +t/app/t2/config.yml +t/app/t2/lib/App3.pm +t/app_alone.t +t/author-no-tabs.t +t/author-pod-syntax.t +t/auto_page.t +t/caller.t +t/charset_server.t +t/classes/Dancer2-Core-Factory/new.t +t/classes/Dancer2-Core-Hook/new.t +t/classes/Dancer2-Core-Request/new.t +t/classes/Dancer2-Core-Request/serializers.t +t/classes/Dancer2-Core-Response-Delayed/after_hooks.t +t/classes/Dancer2-Core-Response-Delayed/new.t +t/classes/Dancer2-Core-Response/new_from.t +t/classes/Dancer2-Core-Role-Engine/with.t +t/classes/Dancer2-Core-Role-Handler/with.t +t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/bin/.exists +t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/lib/fake/inner/dir/.exists +t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/.dancer +t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/fakescript.pl +t/classes/Dancer2-Core-Role-HasLocation/with.t +t/classes/Dancer2-Core-Role-Serializer/with.t +t/classes/Dancer2-Core-Role-StandardResponses/with.t +t/classes/Dancer2-Core-Route/base.t +t/classes/Dancer2-Core-Route/deprecated_param_keys.t +t/classes/Dancer2-Core-Route/match.t +t/classes/Dancer2-Core-Runner/environment.t +t/classes/Dancer2-Core-Runner/new.t +t/classes/Dancer2-Core-Runner/psgi_app.t +t/classes/Dancer2-Core/camelize.t +t/classes/Dancer2/import-pragmas.t +t/classes/Dancer2/import.t +t/config.yml +t/config/config.yml +t/config/environments/failure.yml +t/config/environments/merging.yml +t/config/environments/production.yml +t/config/environments/staging.json +t/config2/config.yml +t/config2/config_local.yml +t/config2/environments/lconfig.yml +t/config2/environments/lconfig_local.yml +t/config_multiapp.t +t/config_reader.t +t/config_settings.t +t/context-in-before.t +t/cookie.t +t/corpus/pretty/505.tt +t/corpus/pretty/relative.tt +t/corpus/pretty_public/404.html +t/corpus/pretty_public/510.html +t/corpus/static/1x1.png +t/corpus/static/index.html +t/custom_dsl.t +t/dancer-test.t +t/dancer-test/config.yml +t/deserialize.t +t/disp_named_capture.t +t/dispatcher.t +t/dsl/any.t +t/dsl/app.t +t/dsl/content.t +t/dsl/delayed.t +t/dsl/error_template.t +t/dsl/extend.t +t/dsl/extend_config/config.yml +t/dsl/halt.t +t/dsl/halt_with_param.t +t/dsl/json.t +t/dsl/parameters.t +t/dsl/pass.t +t/dsl/path.t +t/dsl/request.t +t/dsl/route_retvals.t +t/dsl/send_as.t +t/dsl/send_file.t +t/dsl/splat.t +t/dsl/to_app.t +t/engine.t +t/error.t +t/examples/hello_world.t +t/examples/simple_calculator.t +t/factory.t +t/file_utils.t +t/forward.t +t/forward_before_hook.t +t/forward_hmv_params.t +t/forward_test_tcp.t +t/hooks.t +t/http_methods.t +t/http_status.t +t/issues/config.yml +t/issues/gh-1013/gh-1013.t +t/issues/gh-1013/views/t.tt +t/issues/gh-1046/config.yml +t/issues/gh-1046/gh-1046.t +t/issues/gh-1070.t +t/issues/gh-1098.t +t/issues/gh-1216/gh-1216.t +t/issues/gh-1216/lib/App.pm +t/issues/gh-1216/lib/App/Extra.pm +t/issues/gh-1216/lib/Dancer2/Plugin/Null.pm +t/issues/gh-1226/gh-1226.t +t/issues/gh-1226/lib/App.pm +t/issues/gh-1226/lib/App/Extra.pm +t/issues/gh-1226/lib/Dancer2/Plugin/Test/AccessDSL.pm +t/issues/gh-1230/gh-1230.t +t/issues/gh-1230/lib/App.pm +t/issues/gh-1230/lib/App/Extra.pm +t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessDSL.pm +t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessPluginDSL.pm +t/issues/gh-1232.t +t/issues/gh-596.t +t/issues/gh-634.t +t/issues/gh-639/fails/.dancer +t/issues/gh-639/fails/config.yml +t/issues/gh-639/fails/issue.t +t/issues/gh-639/succeeds/.dancer +t/issues/gh-639/succeeds/config.yml +t/issues/gh-639/succeeds/issue.t +t/issues/gh-650/gh-650.t +t/issues/gh-650/views/environment_setting.tt +t/issues/gh-723.t +t/issues/gh-730.t +t/issues/gh-762.t +t/issues/gh-762/views/404.tt +t/issues/gh-794.t +t/issues/gh-797.t +t/issues/gh-799.t +t/issues/gh-811.t +t/issues/gh-931.t +t/issues/gh-936.t +t/issues/gh-936/views/error.tt +t/issues/gh-944.t +t/issues/gh-975/config.yml +t/issues/gh-975/gh-975.t +t/issues/gh-975/test_public_dir/test.txt +t/issues/memleak/die_in_hooks.t +t/issues/vars-in-forward.t +t/lib/App1.pm +t/lib/App2.pm +t/lib/Dancer2/Plugin/Bar.pm +t/lib/Dancer2/Plugin/DancerPlugin.pm +t/lib/Dancer2/Plugin/DefineKeywords.pm +t/lib/Dancer2/Plugin/EmptyPlugin.pm +t/lib/Dancer2/Plugin/Foo.pm +t/lib/Dancer2/Plugin/FooPlugin.pm +t/lib/Dancer2/Plugin/Hookee.pm +t/lib/Dancer2/Plugin/OnPluginImport.pm +t/lib/Dancer2/Plugin/PluginWithImport.pm +t/lib/Dancer2/Plugin/Polite.pm +t/lib/Dancer2/Session/SimpleNoChangeId.pm +t/lib/Foo.pm +t/lib/MyDancerDSL.pm +t/lib/PoC/Plugin/Polite.pm +t/lib/SubApp1.pm +t/lib/SubApp2.pm +t/lib/TestApp.pm +t/lib/TestPod.pm +t/lib/TestTypeLibrary.pm +t/lib/poc.pm +t/lib/poc2.pm +t/log_die_before_hook.t +t/log_levels.t +t/logger.t +t/logger_console.t +t/memory_cycles.t +t/mime.t +t/multi_apps.t +t/multi_apps_forward.t +t/multiapp_template_hooks.t +t/named_apps.t +t/no_default_middleware.t +t/plugin2/basic-2.t +t/plugin2/basic.t +t/plugin2/define-keywords.t +t/plugin2/find_plugin.t +t/plugin2/from-config.t +t/plugin2/hooks.t +t/plugin2/inside-plugin.t +t/plugin2/keywords-hooks-namespace.t +t/plugin2/memory_cycles.t +t/plugin2/no-app-munging.t +t/plugin2/no-clobbering.t +t/plugin2/no-config.t +t/plugin2/with-plugins.t +t/plugin_import.t +t/plugin_multiple_apps.t +t/plugin_register.t +t/plugin_syntax.t +t/prepare_app.t +t/psgi_app.t +t/psgi_app_forward_and_pass.t +t/public/file.txt +t/redirect.t +t/release-distmeta.t +t/request.t +t/request_make_forward_to.t +t/request_upload.t +t/response.t +t/roles/hook.t +t/route-pod-coverage/route-pod-coverage.t +t/scope_problems/config.yml +t/scope_problems/dispatcher_internal_request.t +t/scope_problems/keywords_before_template_hook.t +t/scope_problems/session_is_cleared.t +t/scope_problems/views/500.tt +t/scope_problems/with_return_dies.t +t/serializer.t +t/serializer_json.t +t/serializer_mutable.t +t/serializer_mutable_custom.t +t/session_bad_client_cookie.t +t/session_config.t +t/session_engines.t +t/session_forward.t +t/session_hooks.t +t/session_hooks_no_change_id.t +t/session_in_template.t +t/session_lifecycle.t +t/session_object.t +t/shared_engines.t +t/static_content.t +t/template.t +t/template_default_tokens.t +t/template_ext.t +t/template_name.t +t/template_simple.t +t/template_tiny/01_compile.t +t/template_tiny/02_trivial.t +t/template_tiny/03_samples.t +t/template_tiny/04_compat.t +t/template_tiny/05_preparse.t +t/template_tiny/samples/01_hello.tt +t/template_tiny/samples/01_hello.txt +t/template_tiny/samples/01_hello.var +t/template_tiny/samples/02_null.tt +t/template_tiny/samples/02_null.txt +t/template_tiny/samples/02_null.var +t/template_tiny/samples/03_chomp.tt +t/template_tiny/samples/03_chomp.txt +t/template_tiny/samples/03_chomp.var +t/template_tiny/samples/04_nested.tt +t/template_tiny/samples/04_nested.txt +t/template_tiny/samples/04_nested.var +t/template_tiny/samples/05_condition.tt +t/template_tiny/samples/05_condition.txt +t/template_tiny/samples/05_condition.var +t/template_tiny/samples/06_object.tt +t/template_tiny/samples/06_object.txt +t/template_tiny/samples/06_object.var +t/template_tiny/samples/07_nesting.tt +t/template_tiny/samples/07_nesting.txt +t/template_tiny/samples/07_nesting.var +t/template_tiny/samples/08_foreach.tt +t/template_tiny/samples/08_foreach.txt +t/template_tiny/samples/08_foreach.var +t/template_tiny/samples/09_trim.tt +t/template_tiny/samples/09_trim.txt +t/template_tiny/samples/09_trim.var +t/time.t +t/types.t +t/uri_for.t +t/vars.t +t/views/auto_page.tt +t/views/beforetemplate.tt +t/views/folder/page.tt +t/views/index.tt +t/views/layouts/main.tt +t/views/session_in_template.tt +t/views/template_simple_index.tt +t/views/tokens.tt +xt/perlcritic.rc +xt/perltidy.rc +xt/whitespace.t diff --git a/META.json b/META.json new file mode 100644 index 00000000..a20f19a1 --- /dev/null +++ b/META.json @@ -0,0 +1,389 @@ +{ + "abstract" : "Lightweight yet powerful web application framework", + "author" : [ + "Dancer Core Developers" + ], + "dynamic_config" : 1, + "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Dancer2", + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "7.1101", + "Test::CPAN::Meta" : "0" + } + }, + "configure" : { + "requires" : { + "CPAN::Meta::Requirements" : "2.120620", + "ExtUtils::MakeMaker" : "7.1101", + "File::ShareDir::Install" : "0.06", + "Module::Metadata" : "0" + } + }, + "develop" : { + "requires" : { + "AnyEvent" : "0", + "CBOR::XS" : "0", + "Class::Method::Modifiers" : "0", + "Dist::Zilla::Plugin::Test::UnusedVars" : "0", + "Perl::Tidy" : "0", + "Test::CPAN::Meta" : "0", + "Test::Memory::Cycle" : "0", + "Test::MockTime" : "0", + "Test::More" : "0.88", + "Test::NoTabs" : "0", + "Test::Perl::Critic" : "0", + "Test::Pod" : "1.41", + "Test::Whitespaces" : "0", + "YAML::XS" : "0" + } + }, + "runtime" : { + "conflicts" : { + "YAML" : "1.16" + }, + "recommends" : { + "CGI::Deurl::XS" : "0", + "Class::XSAccessor" : "0", + "Cpanel::JSON::XS" : "0", + "Crypt::URandom" : "0", + "HTTP::XSCookies" : "0.000007", + "HTTP::XSHeaders" : "0", + "Math::Random::ISAAC::XS" : "0", + "MooX::TypeTiny" : "0", + "Pod::Simple::Search" : "0", + "Pod::Simple::SimpleTree" : "0", + "Scope::Upper" : "0", + "Type::Tiny::XS" : "0", + "URL::Encode::XS" : "0", + "YAML::XS" : "0" + }, + "requires" : { + "App::Cmd::Setup" : "0", + "Attribute::Handlers" : "0", + "Carp" : "0", + "Clone" : "0", + "Config::Any" : "0", + "Digest::SHA" : "0", + "Encode" : "0", + "Exporter" : "5.57", + "Exporter::Tiny" : "0", + "File::Basename" : "0", + "File::Copy" : "0", + "File::Find" : "0", + "File::Path" : "0", + "File::Share" : "0", + "File::Spec" : "0", + "File::Temp" : "0", + "HTTP::Date" : "0", + "HTTP::Headers::Fast" : "0.21", + "HTTP::Tiny" : "0", + "Hash::Merge::Simple" : "0", + "Hash::MultiValue" : "0", + "Import::Into" : "0", + "JSON::MaybeXS" : "0", + "List::Util" : "1.29", + "MIME::Base64" : "3.13", + "Module::Runtime" : "0", + "Moo" : "2.000000", + "Moo::Role" : "0", + "POSIX" : "0", + "Plack" : "1.0040", + "Plack::Middleware::FixMissingBodyInRedirect" : "0", + "Plack::Middleware::RemoveRedundantBody" : "0", + "Ref::Util" : "0", + "Role::Tiny" : "2.000000", + "Safe::Isa" : "0", + "Sub::Quote" : "0", + "Template" : "0", + "Template::Tiny" : "0", + "Test::Builder" : "0", + "Test::More" : "0.92", + "Type::Tiny" : "1.000006", + "Types::Standard" : "0", + "URI::Escape" : "0", + "YAML" : "0.86", + "parent" : "0" + }, + "suggests" : { + "Fcntl" : "0", + "MIME::Types" : "0" + } + }, + "test" : { + "recommends" : { + "CPAN::Meta" : "2.120900" + }, + "requires" : { + "Capture::Tiny" : "0.12", + "ExtUtils::MakeMaker" : "7.1101", + "File::Spec" : "0", + "HTTP::Cookies" : "0", + "HTTP::Headers" : "0", + "IO::Handle" : "0", + "IPC::Open3" : "0", + "Template" : "0", + "Test::Builder" : "0", + "Test::EOL" : "0", + "Test::Fatal" : "0", + "Test::More" : "0.92" + } + } + }, + "provides" : { + "Dancer2" : { + "file" : "lib/Dancer2.pm", + "version" : "0.300000" + }, + "Dancer2::CLI" : { + "file" : "lib/Dancer2/CLI.pm", + "version" : "0.300000" + }, + "Dancer2::CLI::Command::gen" : { + "file" : "lib/Dancer2/CLI/Command/gen.pm", + "version" : "0.300000" + }, + "Dancer2::CLI::Command::version" : { + "file" : "lib/Dancer2/CLI/Command/version.pm", + "version" : "0.300000" + }, + "Dancer2::Core" : { + "file" : "lib/Dancer2/Core.pm", + "version" : "0.300000" + }, + "Dancer2::Core::App" : { + "file" : "lib/Dancer2/Core/App.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Cookie" : { + "file" : "lib/Dancer2/Core/Cookie.pm", + "version" : "0.300000" + }, + "Dancer2::Core::DSL" : { + "file" : "lib/Dancer2/Core/DSL.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Dispatcher" : { + "file" : "lib/Dancer2/Core/Dispatcher.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Error" : { + "file" : "lib/Dancer2/Core/Error.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Factory" : { + "file" : "lib/Dancer2/Core/Factory.pm", + "version" : "0.300000" + }, + "Dancer2::Core::HTTP" : { + "file" : "lib/Dancer2/Core/HTTP.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Hook" : { + "file" : "lib/Dancer2/Core/Hook.pm", + "version" : "0.300000" + }, + "Dancer2::Core::MIME" : { + "file" : "lib/Dancer2/Core/MIME.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Request" : { + "file" : "lib/Dancer2/Core/Request.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Request::Upload" : { + "file" : "lib/Dancer2/Core/Request/Upload.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Response" : { + "file" : "lib/Dancer2/Core/Response.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Response::Delayed" : { + "file" : "lib/Dancer2/Core/Response/Delayed.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::ConfigReader" : { + "file" : "lib/Dancer2/Core/Role/ConfigReader.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::DSL" : { + "file" : "lib/Dancer2/Core/Role/DSL.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::Engine" : { + "file" : "lib/Dancer2/Core/Role/Engine.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::Handler" : { + "file" : "lib/Dancer2/Core/Role/Handler.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::HasLocation" : { + "file" : "lib/Dancer2/Core/Role/HasLocation.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::Hookable" : { + "file" : "lib/Dancer2/Core/Role/Hookable.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::Logger" : { + "file" : "lib/Dancer2/Core/Role/Logger.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::Serializer" : { + "file" : "lib/Dancer2/Core/Role/Serializer.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::SessionFactory" : { + "file" : "lib/Dancer2/Core/Role/SessionFactory.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::SessionFactory::File" : { + "file" : "lib/Dancer2/Core/Role/SessionFactory/File.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::StandardResponses" : { + "file" : "lib/Dancer2/Core/Role/StandardResponses.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Role::Template" : { + "file" : "lib/Dancer2/Core/Role/Template.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Route" : { + "file" : "lib/Dancer2/Core/Route.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Runner" : { + "file" : "lib/Dancer2/Core/Runner.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Session" : { + "file" : "lib/Dancer2/Core/Session.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Time" : { + "file" : "lib/Dancer2/Core/Time.pm", + "version" : "0.300000" + }, + "Dancer2::Core::Types" : { + "file" : "lib/Dancer2/Core/Types.pm", + "version" : "0.300000" + }, + "Dancer2::FileUtils" : { + "file" : "lib/Dancer2/FileUtils.pm", + "version" : "0.300000" + }, + "Dancer2::Handler::AutoPage" : { + "file" : "lib/Dancer2/Handler/AutoPage.pm", + "version" : "0.300000" + }, + "Dancer2::Handler::File" : { + "file" : "lib/Dancer2/Handler/File.pm", + "version" : "0.300000" + }, + "Dancer2::Logger::Capture" : { + "file" : "lib/Dancer2/Logger/Capture.pm", + "version" : "0.300000" + }, + "Dancer2::Logger::Capture::Trap" : { + "file" : "lib/Dancer2/Logger/Capture/Trap.pm", + "version" : "0.300000" + }, + "Dancer2::Logger::Console" : { + "file" : "lib/Dancer2/Logger/Console.pm", + "version" : "0.300000" + }, + "Dancer2::Logger::Diag" : { + "file" : "lib/Dancer2/Logger/Diag.pm", + "version" : "0.300000" + }, + "Dancer2::Logger::File" : { + "file" : "lib/Dancer2/Logger/File.pm", + "version" : "0.300000" + }, + "Dancer2::Logger::Note" : { + "file" : "lib/Dancer2/Logger/Note.pm", + "version" : "0.300000" + }, + "Dancer2::Logger::Null" : { + "file" : "lib/Dancer2/Logger/Null.pm", + "version" : "0.300000" + }, + "Dancer2::Plugin" : { + "file" : "lib/Dancer2/Plugin.pm", + "version" : "0.300000" + }, + "Dancer2::Serializer::Dumper" : { + "file" : "lib/Dancer2/Serializer/Dumper.pm", + "version" : "0.300000" + }, + "Dancer2::Serializer::JSON" : { + "file" : "lib/Dancer2/Serializer/JSON.pm", + "version" : "0.300000" + }, + "Dancer2::Serializer::Mutable" : { + "file" : "lib/Dancer2/Serializer/Mutable.pm", + "version" : "0.300000" + }, + "Dancer2::Serializer::YAML" : { + "file" : "lib/Dancer2/Serializer/YAML.pm", + "version" : "0.300000" + }, + "Dancer2::Session::Simple" : { + "file" : "lib/Dancer2/Session/Simple.pm", + "version" : "0.300000" + }, + "Dancer2::Session::YAML" : { + "file" : "lib/Dancer2/Session/YAML.pm", + "version" : "0.300000" + }, + "Dancer2::Template::Implementation::ForkedTiny" : { + "file" : "lib/Dancer2/Template/Implementation/ForkedTiny.pm", + "version" : "0.300000" + }, + "Dancer2::Template::Simple" : { + "file" : "lib/Dancer2/Template/Simple.pm", + "version" : "0.300000" + }, + "Dancer2::Template::TemplateToolkit" : { + "file" : "lib/Dancer2/Template/TemplateToolkit.pm", + "version" : "0.300000" + }, + "Dancer2::Template::Tiny" : { + "file" : "lib/Dancer2/Template/Tiny.pm", + "version" : "0.300000" + }, + "Dancer2::Test" : { + "file" : "lib/Dancer2/Test.pm", + "version" : "0.300000" + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "https://github.com/PerlDancer/Dancer2/issues" + }, + "homepage" : "http://perldancer.org/", + "repository" : { + "type" : "git", + "url" : "git://github.com/PerlDancer/Dancer2.git", + "web" : "https://github.com/PerlDancer/Dancer2" + }, + "x_IRC" : "irc://irc.perl.org/#dancer", + "x_WebIRC" : "https://chat.mibbit.com/#dancer@irc.perl.org" + }, + "version" : "0.300000", + "x_generated_by_perl" : "v5.28.2", + "x_serialization_backend" : "Cpanel::JSON::XS version 4.18" +} + diff --git a/META.yml b/META.yml new file mode 100644 index 00000000..d60d9c73 --- /dev/null +++ b/META.yml @@ -0,0 +1,274 @@ +--- +abstract: 'Lightweight yet powerful web application framework' +author: + - 'Dancer Core Developers' +build_requires: + Capture::Tiny: '0.12' + ExtUtils::MakeMaker: '7.1101' + File::Spec: '0' + HTTP::Cookies: '0' + HTTP::Headers: '0' + IO::Handle: '0' + IPC::Open3: '0' + Template: '0' + Test::Builder: '0' + Test::CPAN::Meta: '0' + Test::EOL: '0' + Test::Fatal: '0' + Test::More: '0.92' +configure_requires: + CPAN::Meta::Requirements: '2.120620' + ExtUtils::MakeMaker: '7.1101' + File::ShareDir::Install: '0.06' + Module::Metadata: '0' +conflicts: + YAML: '1.16' +dynamic_config: 1 +generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Dancer2 +provides: + Dancer2: + file: lib/Dancer2.pm + version: '0.300000' + Dancer2::CLI: + file: lib/Dancer2/CLI.pm + version: '0.300000' + Dancer2::CLI::Command::gen: + file: lib/Dancer2/CLI/Command/gen.pm + version: '0.300000' + Dancer2::CLI::Command::version: + file: lib/Dancer2/CLI/Command/version.pm + version: '0.300000' + Dancer2::Core: + file: lib/Dancer2/Core.pm + version: '0.300000' + Dancer2::Core::App: + file: lib/Dancer2/Core/App.pm + version: '0.300000' + Dancer2::Core::Cookie: + file: lib/Dancer2/Core/Cookie.pm + version: '0.300000' + Dancer2::Core::DSL: + file: lib/Dancer2/Core/DSL.pm + version: '0.300000' + Dancer2::Core::Dispatcher: + file: lib/Dancer2/Core/Dispatcher.pm + version: '0.300000' + Dancer2::Core::Error: + file: lib/Dancer2/Core/Error.pm + version: '0.300000' + Dancer2::Core::Factory: + file: lib/Dancer2/Core/Factory.pm + version: '0.300000' + Dancer2::Core::HTTP: + file: lib/Dancer2/Core/HTTP.pm + version: '0.300000' + Dancer2::Core::Hook: + file: lib/Dancer2/Core/Hook.pm + version: '0.300000' + Dancer2::Core::MIME: + file: lib/Dancer2/Core/MIME.pm + version: '0.300000' + Dancer2::Core::Request: + file: lib/Dancer2/Core/Request.pm + version: '0.300000' + Dancer2::Core::Request::Upload: + file: lib/Dancer2/Core/Request/Upload.pm + version: '0.300000' + Dancer2::Core::Response: + file: lib/Dancer2/Core/Response.pm + version: '0.300000' + Dancer2::Core::Response::Delayed: + file: lib/Dancer2/Core/Response/Delayed.pm + version: '0.300000' + Dancer2::Core::Role::ConfigReader: + file: lib/Dancer2/Core/Role/ConfigReader.pm + version: '0.300000' + Dancer2::Core::Role::DSL: + file: lib/Dancer2/Core/Role/DSL.pm + version: '0.300000' + Dancer2::Core::Role::Engine: + file: lib/Dancer2/Core/Role/Engine.pm + version: '0.300000' + Dancer2::Core::Role::Handler: + file: lib/Dancer2/Core/Role/Handler.pm + version: '0.300000' + Dancer2::Core::Role::HasLocation: + file: lib/Dancer2/Core/Role/HasLocation.pm + version: '0.300000' + Dancer2::Core::Role::Hookable: + file: lib/Dancer2/Core/Role/Hookable.pm + version: '0.300000' + Dancer2::Core::Role::Logger: + file: lib/Dancer2/Core/Role/Logger.pm + version: '0.300000' + Dancer2::Core::Role::Serializer: + file: lib/Dancer2/Core/Role/Serializer.pm + version: '0.300000' + Dancer2::Core::Role::SessionFactory: + file: lib/Dancer2/Core/Role/SessionFactory.pm + version: '0.300000' + Dancer2::Core::Role::SessionFactory::File: + file: lib/Dancer2/Core/Role/SessionFactory/File.pm + version: '0.300000' + Dancer2::Core::Role::StandardResponses: + file: lib/Dancer2/Core/Role/StandardResponses.pm + version: '0.300000' + Dancer2::Core::Role::Template: + file: lib/Dancer2/Core/Role/Template.pm + version: '0.300000' + Dancer2::Core::Route: + file: lib/Dancer2/Core/Route.pm + version: '0.300000' + Dancer2::Core::Runner: + file: lib/Dancer2/Core/Runner.pm + version: '0.300000' + Dancer2::Core::Session: + file: lib/Dancer2/Core/Session.pm + version: '0.300000' + Dancer2::Core::Time: + file: lib/Dancer2/Core/Time.pm + version: '0.300000' + Dancer2::Core::Types: + file: lib/Dancer2/Core/Types.pm + version: '0.300000' + Dancer2::FileUtils: + file: lib/Dancer2/FileUtils.pm + version: '0.300000' + Dancer2::Handler::AutoPage: + file: lib/Dancer2/Handler/AutoPage.pm + version: '0.300000' + Dancer2::Handler::File: + file: lib/Dancer2/Handler/File.pm + version: '0.300000' + Dancer2::Logger::Capture: + file: lib/Dancer2/Logger/Capture.pm + version: '0.300000' + Dancer2::Logger::Capture::Trap: + file: lib/Dancer2/Logger/Capture/Trap.pm + version: '0.300000' + Dancer2::Logger::Console: + file: lib/Dancer2/Logger/Console.pm + version: '0.300000' + Dancer2::Logger::Diag: + file: lib/Dancer2/Logger/Diag.pm + version: '0.300000' + Dancer2::Logger::File: + file: lib/Dancer2/Logger/File.pm + version: '0.300000' + Dancer2::Logger::Note: + file: lib/Dancer2/Logger/Note.pm + version: '0.300000' + Dancer2::Logger::Null: + file: lib/Dancer2/Logger/Null.pm + version: '0.300000' + Dancer2::Plugin: + file: lib/Dancer2/Plugin.pm + version: '0.300000' + Dancer2::Serializer::Dumper: + file: lib/Dancer2/Serializer/Dumper.pm + version: '0.300000' + Dancer2::Serializer::JSON: + file: lib/Dancer2/Serializer/JSON.pm + version: '0.300000' + Dancer2::Serializer::Mutable: + file: lib/Dancer2/Serializer/Mutable.pm + version: '0.300000' + Dancer2::Serializer::YAML: + file: lib/Dancer2/Serializer/YAML.pm + version: '0.300000' + Dancer2::Session::Simple: + file: lib/Dancer2/Session/Simple.pm + version: '0.300000' + Dancer2::Session::YAML: + file: lib/Dancer2/Session/YAML.pm + version: '0.300000' + Dancer2::Template::Implementation::ForkedTiny: + file: lib/Dancer2/Template/Implementation/ForkedTiny.pm + version: '0.300000' + Dancer2::Template::Simple: + file: lib/Dancer2/Template/Simple.pm + version: '0.300000' + Dancer2::Template::TemplateToolkit: + file: lib/Dancer2/Template/TemplateToolkit.pm + version: '0.300000' + Dancer2::Template::Tiny: + file: lib/Dancer2/Template/Tiny.pm + version: '0.300000' + Dancer2::Test: + file: lib/Dancer2/Test.pm + version: '0.300000' +recommends: + CGI::Deurl::XS: '0' + Class::XSAccessor: '0' + Cpanel::JSON::XS: '0' + Crypt::URandom: '0' + HTTP::XSCookies: '0.000007' + HTTP::XSHeaders: '0' + Math::Random::ISAAC::XS: '0' + MooX::TypeTiny: '0' + Pod::Simple::Search: '0' + Pod::Simple::SimpleTree: '0' + Scope::Upper: '0' + Type::Tiny::XS: '0' + URL::Encode::XS: '0' + YAML::XS: '0' +requires: + App::Cmd::Setup: '0' + Attribute::Handlers: '0' + Carp: '0' + Clone: '0' + Config::Any: '0' + Digest::SHA: '0' + Encode: '0' + Exporter: '5.57' + Exporter::Tiny: '0' + File::Basename: '0' + File::Copy: '0' + File::Find: '0' + File::Path: '0' + File::Share: '0' + File::Spec: '0' + File::Temp: '0' + HTTP::Date: '0' + HTTP::Headers::Fast: '0.21' + HTTP::Tiny: '0' + Hash::Merge::Simple: '0' + Hash::MultiValue: '0' + Import::Into: '0' + JSON::MaybeXS: '0' + List::Util: '1.29' + MIME::Base64: '3.13' + Module::Runtime: '0' + Moo: '2.000000' + Moo::Role: '0' + POSIX: '0' + Plack: '1.0040' + Plack::Middleware::FixMissingBodyInRedirect: '0' + Plack::Middleware::RemoveRedundantBody: '0' + Ref::Util: '0' + Role::Tiny: '2.000000' + Safe::Isa: '0' + Sub::Quote: '0' + Template: '0' + Template::Tiny: '0' + Test::Builder: '0' + Test::More: '0.92' + Type::Tiny: '1.000006' + Types::Standard: '0' + URI::Escape: '0' + YAML: '0.86' + parent: '0' +resources: + IRC: irc://irc.perl.org/#dancer + WebIRC: https://chat.mibbit.com/#dancer@irc.perl.org + bugtracker: https://github.com/PerlDancer/Dancer2/issues + homepage: http://perldancer.org/ + repository: git://github.com/PerlDancer/Dancer2.git +version: '0.300000' +x_generated_by_perl: v5.28.2 +x_serialization_backend: 'YAML::Tiny version 1.73' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 00000000..ab202b9f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,217 @@ +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. +use strict; +use warnings; + + + +use ExtUtils::MakeMaker 7.1101; + +use File::ShareDir::Install; +$File::ShareDir::Install::INCLUDE_DOTFILES = 1; +$File::ShareDir::Install::INCLUDE_DOTDIRS = 1; +install_share dist => "share"; + + +my %WriteMakefileArgs = ( + "ABSTRACT" => "Lightweight yet powerful web application framework", + "AUTHOR" => "Dancer Core Developers", + "BUILD_REQUIRES" => { + "ExtUtils::MakeMaker" => "7.1101", + "Test::CPAN::Meta" => 0 + }, + "CONFIGURE_REQUIRES" => { + "CPAN::Meta::Requirements" => "2.120620", + "ExtUtils::MakeMaker" => "7.1101", + "File::ShareDir::Install" => "0.06", + "Module::Metadata" => 0 + }, + "DISTNAME" => "Dancer2", + "EXE_FILES" => [ + "script/dancer2" + ], + "LICENSE" => "perl", + "NAME" => "Dancer2", + "PREREQ_PM" => { + "App::Cmd::Setup" => 0, + "Attribute::Handlers" => 0, + "Carp" => 0, + "Clone" => 0, + "Config::Any" => 0, + "Digest::SHA" => 0, + "Encode" => 0, + "Exporter" => "5.57", + "Exporter::Tiny" => 0, + "File::Basename" => 0, + "File::Copy" => 0, + "File::Find" => 0, + "File::Path" => 0, + "File::Share" => 0, + "File::Spec" => 0, + "File::Temp" => 0, + "HTTP::Date" => 0, + "HTTP::Headers::Fast" => "0.21", + "HTTP::Tiny" => 0, + "Hash::Merge::Simple" => 0, + "Hash::MultiValue" => 0, + "Import::Into" => 0, + "JSON::MaybeXS" => 0, + "List::Util" => "1.29", + "MIME::Base64" => "3.13", + "Module::Runtime" => 0, + "Moo" => "2.000000", + "Moo::Role" => 0, + "POSIX" => 0, + "Plack" => "1.0040", + "Plack::Middleware::FixMissingBodyInRedirect" => 0, + "Plack::Middleware::RemoveRedundantBody" => 0, + "Ref::Util" => 0, + "Role::Tiny" => "2.000000", + "Safe::Isa" => 0, + "Sub::Quote" => 0, + "Template" => 0, + "Template::Tiny" => 0, + "Test::Builder" => 0, + "Test::More" => "0.92", + "Type::Tiny" => "1.000006", + "Types::Standard" => 0, + "URI::Escape" => 0, + "YAML" => "0.86", + "parent" => 0 + }, + "TEST_REQUIRES" => { + "Capture::Tiny" => "0.12", + "ExtUtils::MakeMaker" => "7.1101", + "File::Spec" => 0, + "HTTP::Cookies" => 0, + "HTTP::Headers" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Template" => 0, + "Test::Builder" => 0, + "Test::EOL" => 0, + "Test::Fatal" => 0, + "Test::More" => "0.92" + }, + "VERSION" => "0.300000", + "test" => { + "TESTS" => "t/*.t t/classes/Dancer2-Core-Factory/*.t t/classes/Dancer2-Core-Hook/*.t t/classes/Dancer2-Core-Request/*.t t/classes/Dancer2-Core-Response-Delayed/*.t t/classes/Dancer2-Core-Response/*.t t/classes/Dancer2-Core-Role-Engine/*.t t/classes/Dancer2-Core-Role-Handler/*.t t/classes/Dancer2-Core-Role-HasLocation/*.t t/classes/Dancer2-Core-Role-Serializer/*.t t/classes/Dancer2-Core-Role-StandardResponses/*.t t/classes/Dancer2-Core-Route/*.t t/classes/Dancer2-Core-Runner/*.t t/classes/Dancer2-Core/*.t t/classes/Dancer2/*.t t/dsl/*.t t/examples/*.t t/issues/*.t t/issues/gh-1013/*.t t/issues/gh-1046/*.t t/issues/gh-1216/*.t t/issues/gh-1226/*.t t/issues/gh-1230/*.t t/issues/gh-639/fails/*.t t/issues/gh-639/succeeds/*.t t/issues/gh-650/*.t t/issues/gh-975/*.t t/issues/memleak/*.t t/plugin2/*.t t/roles/*.t t/route-pod-coverage/*.t t/scope_problems/*.t t/template_tiny/*.t" + } +); + + +my %FallbackPrereqs = ( + "App::Cmd::Setup" => 0, + "Attribute::Handlers" => 0, + "Capture::Tiny" => "0.12", + "Carp" => 0, + "Clone" => 0, + "Config::Any" => 0, + "Digest::SHA" => 0, + "Encode" => 0, + "Exporter" => "5.57", + "Exporter::Tiny" => 0, + "ExtUtils::MakeMaker" => "7.1101", + "File::Basename" => 0, + "File::Copy" => 0, + "File::Find" => 0, + "File::Path" => 0, + "File::Share" => 0, + "File::Spec" => 0, + "File::Temp" => 0, + "HTTP::Cookies" => 0, + "HTTP::Date" => 0, + "HTTP::Headers" => 0, + "HTTP::Headers::Fast" => "0.21", + "HTTP::Tiny" => 0, + "Hash::Merge::Simple" => 0, + "Hash::MultiValue" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Import::Into" => 0, + "JSON::MaybeXS" => 0, + "List::Util" => "1.29", + "MIME::Base64" => "3.13", + "Module::Runtime" => 0, + "Moo" => "2.000000", + "Moo::Role" => 0, + "POSIX" => 0, + "Plack" => "1.0040", + "Plack::Middleware::FixMissingBodyInRedirect" => 0, + "Plack::Middleware::RemoveRedundantBody" => 0, + "Ref::Util" => 0, + "Role::Tiny" => "2.000000", + "Safe::Isa" => 0, + "Sub::Quote" => 0, + "Template" => 0, + "Template::Tiny" => 0, + "Test::Builder" => 0, + "Test::CPAN::Meta" => 0, + "Test::EOL" => 0, + "Test::Fatal" => 0, + "Test::More" => "0.92", + "Type::Tiny" => "1.000006", + "Types::Standard" => 0, + "URI::Escape" => 0, + "YAML" => "0.86", + "parent" => 0 +); + +# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.035 +if (has_module('HTTP::XSCookies')) { +requires('HTTP::XSCookies', '0.000007') +} + + + +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); +} + +# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.035 +sub _add_prereq { + my ($mm_key, $module, $version_or_range) = @_; + $version_or_range ||= 0; + warn "$module already exists in $mm_key (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" + if exists $WriteMakefileArgs{$mm_key}{$module} + and $WriteMakefileArgs{$mm_key}{$module} ne '0' + and $WriteMakefileArgs{$mm_key}{$module} ne $version_or_range; + warn "$module already exists in FallbackPrereqs (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" + if exists $FallbackPrereqs{$module} and $FallbackPrereqs{$module} ne '0' + and $FallbackPrereqs{$module} ne $version_or_range; + $WriteMakefileArgs{$mm_key}{$module} = $FallbackPrereqs{$module} = $version_or_range; + return; +} + +sub has_module { + my ($module, $version_or_range) = @_; + require Module::Metadata; + my $mmd = Module::Metadata->new_from_module($module); + return undef if not $mmd; + return $mmd->version($module) if not defined $version_or_range; + + require CPAN::Meta::Requirements; + my $req = CPAN::Meta::Requirements->new; + $req->add_string_requirement($module => $version_or_range); + return 1 if $req->accepts_module($module => $mmd->version($module)); + return 0; +} + +sub requires { goto &runtime_requires } + +sub runtime_requires { + my ($module, $version_or_range) = @_; + _add_prereq(PREREQ_PM => $module, $version_or_range); +} diff --git a/cpanfile b/cpanfile new file mode 100644 index 00000000..8ed36663 --- /dev/null +++ b/cpanfile @@ -0,0 +1,95 @@ +requires 'App::Cmd::Setup'; +requires 'Attribute::Handlers'; +requires 'Carp'; +requires 'Clone'; +requires 'Config::Any'; +requires 'Digest::SHA'; +requires 'Encode'; +requires 'Exporter', '5.57'; +requires 'Exporter::Tiny'; +requires 'File::Basename'; +requires 'File::Copy'; +requires 'File::Find'; +requires 'File::Path'; +requires 'File::Share'; +requires 'File::Spec'; +requires 'File::Temp'; +requires 'Hash::Merge::Simple'; +requires 'Hash::MultiValue'; +requires 'HTTP::Date'; +requires 'HTTP::Headers::Fast', '0.21'; +requires 'HTTP::Tiny'; +requires 'Import::Into'; +requires 'JSON::MaybeXS'; +requires 'List::Util', '1.29'; # 1.29 has the pair* functions +requires 'MIME::Base64', '3.13'; # 3.13 has the URL safe variants +requires 'Module::Runtime'; +requires 'Moo', '2.000000'; +requires 'Moo::Role'; +requires 'parent'; +requires 'Plack', '1.0040'; +requires 'Plack::Middleware::FixMissingBodyInRedirect'; +requires 'Plack::Middleware::RemoveRedundantBody'; +requires 'POSIX'; +requires 'Ref::Util'; +requires 'Role::Tiny', '2.000000'; +requires 'Safe::Isa'; +requires 'Sub::Quote'; +requires 'Template'; +requires 'Template::Tiny'; +requires 'Test::Builder'; +requires 'Test::More'; +requires 'Types::Standard'; +requires 'Type::Tiny', '1.000006'; +requires 'URI::Escape'; + +# Minimum version of YAML is needed due to: +# - https://github.com/PerlDancer/Dancer2/issues/899 +# Excluded 1.16 is needs due to: +# - http://www.cpantesters.org/cpan/report/25911c10-4199-11e6-8d7d-86c55bc2a771 +# - http://www.cpantesters.org/cpan/report/284ac158-419a-11e6-9a35-e3e15bc2a771 +requires 'YAML', '0.86'; +conflicts 'YAML', '1.16'; + +recommends 'CGI::Deurl::XS'; +recommends 'Class::XSAccessor'; +recommends 'Cpanel::JSON::XS'; +recommends 'Crypt::URandom'; +recommends 'HTTP::XSCookies', '0.000007'; +recommends 'HTTP::XSHeaders'; +recommends 'Math::Random::ISAAC::XS'; +recommends 'MooX::TypeTiny'; +recommends 'Pod::Simple::Search'; +recommends 'Pod::Simple::SimpleTree'; +recommends 'Scope::Upper'; +recommends 'Type::Tiny::XS'; +recommends 'URL::Encode::XS'; +recommends 'YAML::XS'; + +suggests 'Fcntl'; +suggests 'MIME::Types'; + +test_requires 'Capture::Tiny', '0.12'; +test_requires 'HTTP::Cookies'; +test_requires 'HTTP::Headers'; +test_requires 'Template'; +test_requires 'Test::Builder'; +test_requires 'Test::EOL'; +test_requires 'Test::Fatal'; +test_requires 'Test::More'; +test_requires 'Test::More', '0.92'; + +build_requires 'Test::CPAN::Meta'; + +author_requires 'Test::NoTabs'; +author_requires 'Test::Pod'; +author_requires 'AnyEvent'; +author_requires 'CBOR::XS'; +author_requires 'Class::Method::Modifiers'; +author_requires 'Dist::Zilla::Plugin::Test::UnusedVars'; +author_requires 'Perl::Tidy'; +author_requires 'Test::Memory::Cycle'; +author_requires 'Test::MockTime'; +author_requires 'Test::Perl::Critic'; +author_requires 'Test::Whitespaces'; +author_requires 'YAML::XS'; diff --git a/examples/single/hello_world.psgi b/examples/single/hello_world.psgi new file mode 100644 index 00000000..65ba6640 --- /dev/null +++ b/examples/single/hello_world.psgi @@ -0,0 +1,7 @@ +use Dancer2; + +get '/' => sub { + return 'Hello World'; +}; + +__PACKAGE__->to_app; diff --git a/examples/single/simple_calculator.psgi b/examples/single/simple_calculator.psgi new file mode 100644 index 00000000..e3d78134 --- /dev/null +++ b/examples/single/simple_calculator.psgi @@ -0,0 +1,36 @@ +use Dancer2; + +get '/' => sub { + return q{Welcome to simple calculator, powered by Dancer2. + <a href="/add/2/3">add 2 + 3</a> + <a href="/multiply?x=2&y=3">multiply</a> + <form method="POST" action="/division"> + <input name="x"><input name="y"> + <input type="submit" value="Division"> + </form> +}; +}; + + +get '/add/:x/:y' => sub { + my $x = route_parameters->{'x'}; + my $y = route_parameters->{'y'}; + + return ($x+$y); +}; + +get '/multiply' => sub { + my $x = query_parameters->{'x'}; + my $y = query_parameters->{'y'}; + + return ($x*$y); +}; + +post '/division' => sub { + my $x = body_parameters->{'x'}; + my $y = body_parameters->{'y'}; + + return int($x/$y); +}; + +__PACKAGE__->to_app; diff --git a/lib/Dancer2.pm b/lib/Dancer2.pm new file mode 100644 index 00000000..6ee105df --- /dev/null +++ b/lib/Dancer2.pm @@ -0,0 +1,395 @@ +package Dancer2; +$Dancer2::VERSION = '0.300000'; +# ABSTRACT: Lightweight yet powerful web application framework + +use strict; +use warnings; +use List::Util 'first'; +use Module::Runtime 'use_module'; +use Import::Into; +use Dancer2::Core; +use Dancer2::Core::App; +use Dancer2::Core::Runner; +use Dancer2::FileUtils; + +our $AUTHORITY = 'SUKRIA'; + +sub VERSION { shift->SUPER::VERSION(@_) || '0.000000_000' } + +our $runner; + +sub runner {$runner} +sub psgi_app { shift->runner->psgi_app(@_) } + +sub import { + my ($class, @args) = @_; + my ($caller, $script) = caller; + + my @final_args; + my $clean_import; + foreach my $arg (@args) { + + # ignore, no longer necessary + # in the future these will warn as deprecated + grep +($arg eq $_), qw<:script :syntax :tests> + and next; + + if ($arg eq ':nopragmas') { + $clean_import++; + next; + } + + if (substr($arg, 0, 1) eq '!') { + push @final_args, $arg, 1; + } + else { + push @final_args, $arg; + } + } + + $clean_import + or $_->import::into($caller) + for qw<strict warnings utf8>; + + scalar @final_args % 2 + and die q{parameters must be key/value pairs or '!keyword'}; + + my %final_args = @final_args; + + my $appname = delete $final_args{appname}; + $appname ||= $caller; + + # never instantiated the runner, should do it now + if (not defined $runner) { + $runner = Dancer2::Core::Runner->new(); + } + + # Search through registered apps, creating a new app object + # if we do not find one with the same name. + my $app; + ($app) = first { $_->name eq $appname } @{$runner->apps}; + + if (!$app) { + + # populating with the server's postponed hooks in advance + $app = Dancer2::Core::App->new( + name => $appname, + caller => $script, + environment => $runner->environment, + postponed_hooks => $runner->postponed_hooks->{$appname} || {}, + ); + + # register the app within the runner instance + $runner->register_application($app); + } + + _set_import_method_to_caller($caller); + + # use config dsl class, must extend Dancer2::Core::DSL + my $config_dsl = $app->setting('dsl_class') || 'Dancer2::Core::DSL'; + $final_args{dsl} ||= $config_dsl; + + # load the DSL, defaulting to Dancer2::Core::DSL + my $dsl = use_module($final_args{dsl})->new(app => $app); + $dsl->export_symbols_to($caller, \%final_args); +} + +sub _set_import_method_to_caller { + my ($caller) = @_; + + my $import = sub { + my ($self, %options) = @_; + + my $with = $options{with}; + for my $key (keys %$with) { + $self->dancer_app->setting($key => $with->{$key}); + } + }; + + { + ## no critic + no strict 'refs'; + no warnings 'redefine'; + *{"${caller}::import"} = $import; + } +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2 - Lightweight yet powerful web application framework + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Dancer2 is the new generation of L<Dancer>, the lightweight web-framework for +Perl. Dancer2 is a complete rewrite based on L<Moo>. + +Dancer2 can optionally use XS modules for speed, but at its core remains +fatpackable (packable by L<App::FatPacker>) so you could easily deploy Dancer2 +applications on hosts that do not support custom CPAN modules. + +Dancer2 is easy and fun: + + use Dancer2; + get '/' => sub { "Hello World" }; + dance; + +This is the main module for the Dancer2 distribution. It contains logic for +creating a new Dancer2 application. + +=head2 Documentation Index + +Documentation on Dancer2 is split into several sections. Below is a +complete outline on where to go for help. + +=over 4 + +=item * Dancer2 Tutorial + +If you are new to the Dancer approach, you should start by reading +our L<Dancer2::Tutorial>. + +=item * Dancer2 Manual + +L<Dancer2::Manual> is the reference for Dancer2. Here you will find +information on the concepts of Dancer2 application development and +a comprehensive reference to the Dancer2 domain specific +language. + +=item * Dancer2 Keywords + +The keywords for Dancer2 can be found under L<DSL Keywords|Dancer2::Manual/DSL KEYWORDS>. + +=item * Dancer2 Deployment + +For configuration examples of different deployment solutions involving +Dancer2 and Plack, refer to L<Dancer2::Manual::Deployment>. + +=item * Dancer2 Cookbook + +Specific examples of code for real-life problems and some 'tricks' for +applications in Dancer can be found in L<Dancer2::Cookbook> + +=item * Dancer2 Config + +For configuration file details refer to L<Dancer2::Config>. It is a +complete list of all configuration options. + +=item * Dancer2 Plugins + +Refer to L<Dancer2::Plugins> for a partial list of available Dancer2 +plugins. Note that although we try to keep this list up to date we +expect plugin authors to tell us about new modules. + +For information on how to author a plugin, see L<Dancer2::Plugin/Writing the plugin>. + +=item * Dancer2 Migration guide + +L<Dancer2::Manual::Migration> provides the most up-to-date instruction on +how to convert a Dancer (1) based application to Dancer2. + +=back + +=head1 FUNCTIONS + +=head2 my $runner=runner(); + +Returns the current runner. It is of type L<Dancer2::Core::Runner>. + +=head1 SECURITY REPORTS + +If you need to report a security vulnerability in Dancer2, send all pertinent +information to L<mailto:dancer-security@dancer.pm>. These matters are taken +extremely seriously, and will be addressed in the earliest timeframe possible. + +=head1 SUPPORT + +You are welcome to join our mailing list. +For subscription information, mail address and archives see +L<http://lists.preshweb.co.uk/mailman/listinfo/dancer-users>. + +We are also on IRC: #dancer on irc.perl.org. + +=head1 AUTHORS + +=head2 CORE DEVELOPERS + + Alberto Simões + Alexis Sukrieh + Damien Krotkine + David Precious + Franck Cuny + Jason A. Crome + Mickey Nasriachi + Peter Mottram (SysPete) + Russell Jenkins + Sawyer X + Stefan Hornburg (Racke) + Steven Humphrey + Yanick Champoux + +=head2 CORE DEVELOPERS EMERITUS + + David Golden + +=head2 CONTRIBUTORS + + A. Sinan Unur + Abdullah Diab + Ahmad M. Zawawi + Alex Beamish + Alexander Karelas + Alexandr Ciornii + Andrew Beverley + Andrew Grangaard + Andrew Inishev + Andrew Solomon + Andy Jack + Ashvini V + B10m + Bas Bloemsaat + baynes + Ben Hutton + Ben Kaufman + biafra + Blabos de Blebe + Breno G. de Oliveira + cdmalon + Celogeek + Cesare Gargano + Charlie Gonzalez + chenchen000 + Chi Trinh + Christian Walde + Christopher White + Colin Kuskie + cym0n + Dale Gallagher + Dan Book (Grinnz) + Daniel Böhmer + Daniel Muey + Daniel Perrett + Dave Jacoby + Dave Webb + David (sbts) + David Steinbrunner + David Zurborg + Davs + Deirdre Moran + Dennis Lichtenthäler + Dinis Rebolo + dtcyganov + Erik Smit + Fayland Lam + Gabor Szabo + geistteufel + Gideon D'souza + Gil Magno + Glenn Fowler + Graham Knop + Gregor Herrmann + Grzegorz Rożniecki + Hobbestigrou + Hunter McMillen + Ivan Bessarabov + Ivan Kruglov + JaHIY + Jakob Voss + James Aitken + James Raspass + James McCoy + Jason Lewis + Javier Rojas + Jean Stebens + Jens Rehsack + Joel Berger + Johannes Piehler + Jonathan Cast + Jonathan Scott Duff + Joseph Frazer + Julien Fiegehenn (simbabque) + Julio Fraire + Kaitlyn Parkhurst (SYMKAT) + kbeyazli + Keith Broughton + lbeesley + Lennart Hengstmengel + Ludovic Tolhurst-Cleaver + Mario Zieschang + Mark A. Stratman + Marketa Wachtlova + Masaaki Saito + Mateu X Hunter + Matt Phillips + Matt S Trout + Maurice + MaxPerl + Menno Blom + Michael Kröll + Michał Wojciechowski + Mike Katasonov + Mohammad S Anwar + mokko + Nick Patch + Nick Tonkin + Nigel Gregoire + Nikita K + Nuno Carvalho + Olaf Alders + Olivier Mengué + Omar M. Othman + pants + Patrick Zimmermann + Pau Amma + Paul Cochrane + Paul Williams + Pedro Bruno + Pedro Melo + Philippe Bricout + Ricardo Signes + Rick Yakubowski + Ruben Amortegui + Sakshee Vijay (sakshee3) + Sam Kington + Samit Badle + Sebastien Deseille (sdeseille) + Sergiy Borodych + Shlomi Fish + Slava Goltser + Snigdha + Steve Dondley + Tatsuhiko Miyagawa + Tina Müller + Tom Hukins + Upasana Shukla + Utkarsh Gupta + Vernon Lyon + Victor Adam + Vince Willems + Vincent Bachelier + xenu + Yves Orton + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/CLI.pm b/lib/Dancer2/CLI.pm new file mode 100644 index 00000000..bc659de4 --- /dev/null +++ b/lib/Dancer2/CLI.pm @@ -0,0 +1,35 @@ +package Dancer2::CLI; +# ABSTRACT: Dancer2 cli application +$Dancer2::CLI::VERSION = '0.300000'; +use strict; +use warnings; +use App::Cmd::Setup -app; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::CLI - Dancer2 cli application + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/CLI/Command/gen.pm b/lib/Dancer2/CLI/Command/gen.pm new file mode 100644 index 00000000..f72170d7 --- /dev/null +++ b/lib/Dancer2/CLI/Command/gen.pm @@ -0,0 +1,323 @@ +# ABSTRACT: create new Dancer2 application +package Dancer2::CLI::Command::gen; +$Dancer2::CLI::Command::gen::VERSION = '0.300000'; +use strict; +use warnings; + +use App::Cmd::Setup -command; + +use HTTP::Tiny; +use File::Find; +use File::Path 'mkpath'; +use File::Spec::Functions; +use File::Share 'dist_dir'; +use File::Basename qw/dirname basename/; +use Dancer2::Template::Simple; +use Module::Runtime 'require_module'; + +my $SKEL_APP_FILE = 'lib/AppFile.pm'; + +sub description { 'Helper script to create new Dancer2 applications' } + +sub opt_spec { + return ( + [ 'application|a=s', 'application name' ], + [ 'directory|d=s', 'application folder (default: same as application name)' ], + [ 'path|p=s', 'application path (default: current directory)', + { default => '.' } ], + [ 'overwrite|o', 'overwrite existing files' ], + [ 'no-check|x', 'don\'t check latest Dancer2 version (requires internet)' ], + [ 'skel|s=s', 'skeleton directory' ], + ); +} + +sub validate_args { + my ($self, $opt, $args) = @_; + + my $name = $opt->{application} + or $self->usage_error('Application name must be defined'); + + if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/ ) { + $self->usage_error( + "Invalid application name.\n" . + "Application names must not contain single colons, dots, " . + "hyphens or start with a number.\n" + ); + } + + my $path = $opt->{path}; + -d $path or $self->usage_error("directory '$path' does not exist"); + -w $path or $self->usage_error("directory '$path' is not writeable"); + + if ( my $skel_path = $opt->{skel} ) { + -d $skel_path + or $self->usage_error("skeleton directory '$skel_path' not found"); + } +} + +sub execute { + my ($self, $opt, $args) = @_; + $self->_version_check() unless $opt->{'no_check'}; + + my $dist_dir = dist_dir('Dancer2'); + my $skel_dir = $opt->{skel} || catdir($dist_dir, 'skel'); + -d $skel_dir or die "$skel_dir doesn't exist"; + + my $app_name = $opt->{application}; + my $app_file = _get_app_file($app_name); + my $app_path = _get_app_path($opt->{path}, $app_name); + + if( my $dir = $opt->{directory} ) { + $app_path = catdir( $opt->{path}, $dir ); + } + + my $files_to_copy = _build_file_list($skel_dir, $app_path); + foreach my $pair (@$files_to_copy) { + if ($pair->[0] =~ m/$SKEL_APP_FILE$/) { + $pair->[1] = catfile($app_path, $app_file); + last; + } + } + + my $vars = { + appname => $app_name, + appfile => $app_file, + appdir => File::Spec->rel2abs($app_path), + perl_interpreter => _get_perl_interpreter(), + cleanfiles => _get_dashed_name($app_name), + dancer_version => $self->version(), + }; + + _copy_templates($files_to_copy, $vars, $opt->{overwrite}); + _create_manifest($files_to_copy, $app_path); + _add_to_manifest_skip($app_path); + + if ( ! eval { require_module('YAML'); 1; } ) { + print <<'NOYAML'; +***** +WARNING: YAML.pm is not installed. This is not a full dependency, but is highly +recommended; in particular, the scaffolded Dancer app being created will not be +able to read settings from the config file without YAML.pm being installed. + +To resolve this, simply install YAML from CPAN, for instance using one of the +following commands: + + cpan YAML + perl -MCPAN -e 'install YAML' + curl -L http://cpanmin.us | perl - --sudo YAML +***** +NOYAML + } + + print <<HOWTORUN; + +Your new application is ready! To run it: + + cd $app_path + plackup bin/app.psgi + +If you need community assistance, the following resources are available: +- Dancer website: http://perldancer.org +- Mailing list: http://lists.preshweb.co.uk/mailman/listinfo/dancer-users +- IRC: irc.perl.org#dancer + +Happy Dancing! + +HOWTORUN + + return 0; +} + +sub version { + require_module('Dancer2'); + return Dancer2->VERSION; +} + +# skel creation routines +sub _build_file_list { + my ($from, $to) = @_; + $from =~ s{/+$}{}; + my $len = length($from) + 1; + + my @result; + my $wanted = sub { + return unless -f; + my $file = substr($_, $len); + + # ignore .git and git/* + my $is_git = $file =~ m{^\.git(/|$)} + and return; + + push @result, [ $_, catfile($to, $file) ]; + }; + + find({ wanted => $wanted, no_chdir => 1 }, $from); + return \@result; +} + +sub _copy_templates { + my ($files, $vars, $overwrite) = @_; + + foreach my $pair (@$files) { + my ($from, $to) = @{$pair}; + if (-f $to && !$overwrite) { + print "! $to exists, overwrite? [N/y/a]: "; + my $res = <STDIN>; chomp($res); + $overwrite = 1 if $res eq 'a'; + next unless ($res eq 'y') or ($res eq 'a'); + } + + my $to_dir = dirname($to); + if (! -d $to_dir) { + print "+ $to_dir\n"; + mkpath $to_dir or die "could not mkpath $to_dir: $!"; + } + + my $to_file = basename($to); + my $ex = ($to_file =~ s/^\+//); + $to = catfile($to_dir, $to_file) if $ex; + + print "+ $to\n"; + my $content; + + { + local $/; + open(my $fh, '<:raw', $from) or die "unable to open file `$from' for reading: $!"; + $content = <$fh>; + close $fh; + } + + if ($from !~ m/\.(ico|jpg|png|css|eot|map|swp|ttf|svg|woff|woff2|js)$/) { + $content = _process_template($content, $vars); + } + + open(my $fh, '>:raw', $to) or die "unable to open file `$to' for writing: $!"; + print $fh $content; + close $fh; + + if ($ex) { + chmod(0755, $to) or warn "unable to change permissions for $to: $!"; + } + } +} + +sub _create_manifest { + my ($files, $dir) = @_; + + my $manifest_name = catfile($dir, 'MANIFEST'); + open(my $manifest, '>', $manifest_name) or die $!; + print $manifest "MANIFEST\n"; + + foreach my $file (@{$files}) { + my $filename = substr $file->[1], length($dir) + 1; + my $basename = basename $filename; + my $clean_basename = $basename; + $clean_basename =~ s/^\+//; + $filename =~ s/\Q$basename\E/$clean_basename/; + print {$manifest} "$filename\n"; + } + + close($manifest); +} + +sub _add_to_manifest_skip { + my $dir = shift; + + my $filename = catfile($dir, 'MANIFEST.SKIP'); + open my $fh, '>>', $filename or die $!; + print {$fh} "^$dir-\n"; + close $fh; +} + +sub _process_template { + my ($template, $tokens) = @_; + my $engine = Dancer2::Template::Simple->new; + $engine->{start_tag} = '[d2%'; + $engine->{stop_tag} = '%2d]'; + return $engine->render(\$template, $tokens); +} + +sub _get_app_path { + my ($path, $appname) = @_; + return catdir($path, _get_dashed_name($appname)); +} + +sub _get_app_file { + my $appname = shift; + $appname =~ s{::}{/}g; + return catfile('lib', "$appname.pm"); +} + +sub _get_perl_interpreter { + return -r '/usr/bin/env' ? '#!/usr/bin/env perl' : "#!$^X"; +} + +sub _get_dashed_name { + my $name = shift; + $name =~ s{::}{-}g; + return $name; +} + +# version check routines +sub _version_check { + my $self = shift; + my $version = $self->version(); + return if $version =~ m/_/; + + my $latest_version = 0; + my $resp = _send_http_request('http://search.cpan.org/api/module/Dancer2'); + + if ($resp) { + if ( $resp =~ /"version" (?:\s+)? \: (?:\s+)? "(\d\.\d+)"/x ) { + $latest_version = $1; + } else { + die "Can't understand search.cpan.org's reply.\n"; + } + } + + if ($latest_version > $version) { + print qq| +The latest stable Dancer2 release is $latest_version, you are currently using $version. +Please check http://search.cpan.org/dist/Dancer2/ for updates. + +|; + } +} + +sub _send_http_request { + my $url = shift; + + my $ua = HTTP::Tiny->new( timeout => 5 ); + + my $response = $ua->get($url); + return $response->{'success'} ? $response->{'content'} : undef; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::CLI::Command::gen - create new Dancer2 application + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/CLI/Command/version.pm b/lib/Dancer2/CLI/Command/version.pm new file mode 100644 index 00000000..d6c4a720 --- /dev/null +++ b/lib/Dancer2/CLI/Command/version.pm @@ -0,0 +1,48 @@ +package Dancer2::CLI::Command::version; +# ABSTRACT: display version +$Dancer2::CLI::Command::version::VERSION = '0.300000'; +use strict; +use warnings; +use App::Cmd::Setup -command; +use Module::Runtime 'require_module'; + +sub description { 'Display version of Dancer2' } + +sub command_names { + qw/version --version -v/; +} + +sub execute { + require_module('Dancer2'); + print 'Dancer2 ' . Dancer2->VERSION . "\n"; + return 0; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::CLI::Command::version - display version + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Config.pod b/lib/Dancer2/Config.pod new file mode 100644 index 00000000..d93eee3f --- /dev/null +++ b/lib/Dancer2/Config.pod @@ -0,0 +1,684 @@ +package Dancer2::Config; +# ABSTRACT: Configure Dancer2 to suit your needs + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Config - Configure Dancer2 to suit your needs + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +The Dancer2 configuration (as implemented by +L<Dancer2::Core::Role::ConfigReader>) handles reading and changing the +configuration of your Dancer2 apps. This document describes how to +manipulate Dancer2's configuration settings (through code or by file), and +to document the various settings that are available in Dancer2. + +=head1 MANIPULATING SETTINGS VIA CODE + +You can change a setting with the keyword C<set>: + + use Dancer2; + + # changing default settings + set port => 8080; + set content_type => 'text/plain'; + set startup_info => 0; + +=head1 MANIPULATING SETTINGS VIA CONFIGURATION FILES + +There's nothing wrong with using C<set> to configure your application. In +fact you might have some great reasons for doing so. For greater +flexibility, ease of deployment, etc., you should also consider extracting +those settings into a configuration file. + +=head2 Configuration file path and file names + +Dancer2 will first look for the file F<config.EXT> (where F<EXT> is the +type of configuration file you are using; e.g. F<ini> or F<json> or +F<yml>) in the root directory of your application. This is considered +your global Dancer2 config file. If you do not care to have separate +settings for production and development environments (B<not> a +recommended practice!), then this file is all you need. + +Next, Dancer2 will look for a file called F<config_local.EXT>. This file +is typically useful for deployment-specific configuration that should +not be checked into source control. For instance, database credentials +could be stored in this file. Any settings in this file are merged into +the existing configuration such that those with the same name in your +local configuration file will take precedence over those settings in +the global file. + +Next, Dancer2 will look in the F<environments> directory for a configuration +file specific to the platform you are deploying to (F<production.EXT> or +F<development.EXT>, for example). Again, the configuration from the environment +is merged with the existing configuration with the deployment config taking +precedence. + +Finally, Dancer2 will look in the F<environments> directory for a +local configuration for the specific platform you are deploying to +(e.g. F<production_local.EXT> or F<development_local.EXT>) +The configuration in this file is merged as before. + +Much like F<config_local.EXT>, this file would be useful for environment- +specific configuration that would not be checked into source control. +For instance, when developing an application that talks to multiple services, +each developer could have their own URLs to those services stored within +their F<environments/development_local.yaml> file. + +Note, if there is no F<config.EXT>, Dancer2 will not look for a +F<config_local.EXT>. The same is true for the local environment +configuration. + +=head2 Supported configuration file formats + +Dancer2 supports any configuration file format that is supported by +L<Config::Any>. At the time of this writing, that includes YAML (.yml and +.yaml), JSON (.jsn and .json), INI (.ini), Apache-style configurations (.cnf +and .conf), XML (.xml), and Perl-style hashes (.pl and .perl). + +Dancer2 iterates over these file extensions in the order provided by +L<Config::Any> and loads any config files that it finds with later +configuration information overriding earlier config information. To +restrict which file extension Dancer2 looks for, you may set the +C<DANCER_CONFIG_EXT> envinroment variable to a specific extension and +Dancer2 will only look for config files with that extension. + +Make sure you pick the appropriate extension for your configuration file +name, as Dancer2 guesses the type of format based on the file extension. + +=head2 Sample configuration files + +Note: Not all possibilities are covered here, only the most common options. + +If you prefer YAML, a sample YAML based config file might look like this: + + appname: "Hello" + charset: "UTF-8" + auto_page: 1 + + session: "YAML" + serializer: "JSON" + + plugins: + DBIC: + default: + dsn: dbi:SQLite:db/mydata.db + schema_class: Hello::Schema + +If JSON is more your thing, your file might look more like this: + + { + "appname": "Hello", + "charset": "UTF-8", + "auto_page": "1", + "session": "YAML", + "serializer": "JSON", + "plugins": { + "DBIC": { + "default": { + "dsn": "dbi:SQLite:db/mydata.db", + "schema_class": "Hello::Schema" + } + } + } + } + +If you like Apache configuration files, try something similar to: + + appname = Hello + charset = UTF-8 + auto_page = 1 + session = YAML + serializer = JSON + <plugins> + <DBIC> + <default> + dsn = dbi =SQLite =db/mydata.db + schema_class = Hello = =Schema + </default> + </DBIC> + </plugins> + +INI-style files are deliberately simplistic and not recommended for use in +your Dancer2 applications. + +=head1 SUPPORTED SETTINGS + +=head2 Run mode and listening interface/port + +=head3 server (string) + +The IP address that the Dancer2 app should bind to. Default is 0.0.0.0, +i.e. bind to all available interfaces. + +=head3 port (int) + +The port Dancer2 will listen to. + +Default value is 3000. This setting can be changed on the command-line with +the B<--port> switch. + +=head3 behind_proxy (boolean) + +If set to true, Dancer2 will look to C<X-Forwarded-Protocol> and +C<X-Forwarded-host> when constructing URLs (for example, when using C<redirect> +or C<host>). This is useful if your application is behind a proxy. + +B<Note>: If either of these are missing, the values of the proxy server will be +used instead. For example, if the client sends a HTTP/1.0 request to a proxy +that is hosted locally, then C<host> will return the value "localhost". In a +similar vein, if the client makes a secure connection to the proxy, but the +proxy does not pass C<X-Forwarded-Protocol>, then C<base> will return +"http://...". For these reasons, it is recommended that the values are +hard-configured in the proxy if possible. For Apache this would be: + + RequestHeader set X_FORWARDED_PROTO "https" + RequestHeader set X_FORWARDED_HOST "www.example.com" + +=head3 no_default_middleware (boolean) + +If set to true, your Dancer2 application will B<NOT> be wrapped with the default +PSGI middleware. The default middleware wrappers are: + +=over 4 + +=item * L<Plack::Middleware::FixMissingBodyInRedirect> + +=item * L<Plack::Middleware::Head> + +=back + +=head2 Content type / character set + +=head3 content_type (string) + +The default content type of outgoing content. Default value is 'text/html'. + +=head3 charset (string) + +This setting has multiple effects: + +=over + +=item * + +It sets the default charset of outgoing content. C<charset=> item will be +added to Content-Type response header. + +=item * + +It makes Unicode bodies in HTTP responses of C<text/*> types to be encoded +to this charset. + +=item * + +It also indicates to Dancer2 in which charset the static files and templates +are encoded. + +=item * + +If you're using L<Dancer2::Plugin::Database>, UTF-8 support will +automatically be enabled for your database - see +L<Dancer2::Plugin::Database/"AUTOMATIC UTF-8 SUPPORT"> + +=back + +Default value is empty which means don't do anything. HTTP responses without +charset will be interpreted as ISO-8859-1 by most clients. + +You can cancel any charset processing by specifying your own charset in +Content-Type header or by ensuring that response body leaves your handler +without Unicode flag set (by encoding it into some 8bit charset, for +example). + +Also, since automatically serialized JSON responses have C<application/json> +Content-Type, you should always encode them by hand. + +=head3 default_mime_type (string) + +Dancer2's L<Dancer2::Core::MIME> module uses C<application/data> as a +default mime type. This setting lets the user change it. For example, if you +have a lot of files being served in the B<public> folder that do not have an +extension, and are text files, set the C<default_mime_type> to +C<text/plain>. + +=head2 Serializing responses + +=head3 serializer (string) + +When writing a webservice, data serialization/deserialization is a common +issue to deal with. Dancer2 can automatically handle that for you, via a +serializer. + +=head3 Available serializer engines + +The following serializers are available, be aware they dynamically depend on +Perl modules you may not have on your system. + +=over 4 + +=item * B<JSON> + +Requires L<JSON>. + +=item * B<YAML> + +Requires L<YAML>, + +=item * B<XML> + +Requires L<XML::Simple>. + +=item * B<Mutable> + +Will try to find the appropriate serializer using the B<Content-Type> and +B<Accept-type> header of the request. + +=back + +=head2 Serializer engine + +The serializer can be configured in a separate C<engines> section, like so: + + serializer: "JSON" + + engines: + serializer: + JSON: + pretty: 1 + +See documentation for a particular serializer for supported options. + +=head2 File / directory locations + +=head3 environment (string) + +This is the name of the environment that should be used. Standard Dancer2 +applications have a C<environments> folder with specific configuration files +for different environments (usually development and production +environments). They specify different kind of error reporting, deployment +details, etc. These files are read after the generic C<config.yml> +configuration file. + +=head3 appdir (directory) + +This is the path where your application will live. It's where Dancer2 will +look by default for your config files, templates and static content. + +It is typically set by C<use Dancer2> to use the same directory as your +script. + +=head3 public_dir (directory) + +This is the directory, where static files are stored. Any existing file in +that directory will be served as a static file, before matching any route. + +See also B<static_handler>. + +Default: B<< C<$appdir/public> >>. + +=head3 static_handler (boolean) + +This setting have to be declared and set to true if you modify standard +C<public_dir> location. + +Default: true if C<$ENV{DANCER_PUBLIC}> is set or C<public_dir> is set to +B<< C<$appdir/public> >>. + +=head3 views (directory) + +This is the directory where your templates and layouts live. It's the +"view" part of MVC (model, view, controller). + +Default: B<< C<$appdir/views> >>. + +=head2 Templating & layouts + +=head3 template + +Allows you to configure which template engine should be used. For instance, +to use Template Toolkit, add the following to C<config.yml>: + + template: template_toolkit + +=head3 layout (string) + +The name of the layout to use when rendering view. Dancer2 will look for a +matching template in the directory C<$views/layouts>. + +Your can override the default layout using the third argument of the +C<template> keyword. Check C<Dancer2> manpage for details. + +=head3 layout_dir (string) + +A relative path where the layouts reside inside the C<views> directory. + + layout_dir: actual_layouts + +Default: B<layouts>. + +=head2 Logging, debugging and error handling + +=head3 startup_info (boolean) + +If set to true, prints a banner at the server start with information such as +versions and the environment (or "dancefloor"). + +Conforms to the environment variable C<DANCER_STARTUP_INFO>. + +=head3 traces (boolean) + +If set to true, Dancer2 will display full stack traces when a warning or a +die occurs. (Internally sets Carp::Verbose). Default to false. + +=head3 no_server_tokens (boolean) + +If set to true, Dancer2 will B<not> add an "X-Powered-By" header and also append +the Dancer2 version to the "Server" header. Default to false - adding. + +You can also use the environment variable C<DANCER_NO_SERVER_TOKENS>. + +=head3 logger (enum) + +Select which logger to use. For example, to write to log files with +L<Dancer2::Logger::File>: + + logger: File + +Or to direct log messages to the console from which you started your Dancer2 +app with L<Dancer2::Logger::Console>: + + logger: Console + +Loggers are configured with a corresponding L</Logger engine> section, as +shown below. + +=head3 session (enum) + +This setting lets you enable a session engine for your web application. By +default, sessions are disabled in Dancer2, you must choose a session engine +to use them. + +Sessions are configured with a corresponding L</Session engine> section, as +shown below. + +=head3 show_errors (boolean) + +If set to true, Dancer2 will render a detailed debug screen whenever an +error is caught. If set to false, Dancer2 will render the default error +page, using C<$public/$error_code.html> if it exists, C<$views/$error_code.tt> or the template specified +by the C<error_template> setting. + +The error screen attempts to sanitise sensitive looking information +(passwords / card numbers in the request, etc) but you still should not have +show_errors enabled whilst in production, as there is still a risk of +divulging details. + +=head3 error_template (template path) + +This setting lets you specify a template to be used in case of runtime +error. At the present moment the template (as well as C<$views/$error_code.tt> templates) can use four variables: + +=over 4 + +=item B<title> + +The error title. + +=item B<content> + +The error specific content (if any). + +=item B<status> + +The HTTP status code throwing that error. + +=item B<exception> + +The stringified exception (e.g. $@) if any. + +=back + +Keep in mind that 'content' and 'exception' can vary depending on the problem. + +For example: + +A 404 has an empty 'exception' and 'content' contains the URI that was not found. Unless you do the 404 yourself via C<send_error("You chose ... poorly!", 404);>, then 'content' is 'You chose ... poorly!'. + +A 500 because of, say, dividing 0 by 0 will have an empty 'content' and 'exception like 'Illegal division by zero at ...'. + +A 401 from C<send_error("You can not know the secret until you sign in grasshopper!", 401);> will have an empty 'exception' and 'content' will contain 'You can not know the secret until you sign in grasshopper!'. + +=head2 Logger engine + +The logger must be configured in a separate C<engines> section, like so: + + logger: Console + + engines: + logger: + Console: + log_level: core + +All loggers support the configuration options below. See documentation for +a particular logger for other supported options. + +=head3 log_level + +This option tells which log messages should be actually logged. Possible +values are B<core>, B<info>, B<debug>, B<warning> or B<error>. + +=over 4 + +=item B<core> : all messages are logged, including some from Dancer2 itself + +=item B<debug> : all messages are logged + +=item B<info> : only info, warning and error messages are logged + +=item B<warning> : only warning and error messages are logged + +=item B<error> : only error messages are logged + +=back + +During development, you'll probably want to use C<debug> to see your own +debug messages, and C<core> if you need to see what Dancer2 is doing. In +production, you'll likely want C<error> or C<warning> only, for less-chatty +logs. + +=head2 Session engine + +The session engine is configured in the C<engines> section. + + session: Simple + + engines: + session: + Simple: + cookie_name: dance.set + cookie_duration: '24 hours' + is_secure: 1 + is_http_only: 1 + +See L<Dancer2::Core::Role::SessionFactory> for more detailed documentation +for these options, or the particular session engine for other supported +options. + +=head3 cookie_name + +The name of the cookie to store the session ID in. Defaults to +C<dancer.session>. This can be overridden by certain session engines. + +=head3 cookie_domain + +The domain of the cookie. By default there is no domain defined for the +cookie. + +=head3 cookie_path + +The path of the cookie. By default there is no path defined for the cookie. + +=head3 cookie_duration + +The session expiry time in seconds, or as e.g. "2 hours" (see +L<Dancer2::Core::Cookie/expires>. By default, there is no specific expiry +time. + +=head3 is_secure + +The user's session ID is stored in a cookie. If the C<is_secure> setting is +set to a true value, the cookie will be marked as secure, meaning it should +only be sent over HTTPS connections. + +=head3 is_http_only + +This setting defaults to 1 and instructs the session cookie to be created +with the C<HttpOnly> option active, meaning that JavaScript will not be able +to access to its value. + +=head2 auto_page (boolean) + +For simple pages where you're not doing anything dynamic, but still want to +use the template engine to provide headers etc, you can use the auto_page +feature to avoid the need to create a route for each page. + +With C<auto_page> enabled, if the requested path does not match any specific +route, Dancer2 will check in the views directory for a matching template, +and use it to satisfy the request if found. + +Simply enable auto_page in your config: + + auto_page: 1 + +Then, if you request C</foo/bar>, Dancer2 will look in the views dir for +C</foo/bar.tt>. + +Dancer2 will honor your C<before_template_render> code, and all default +variables. They will be accessible and interpolated on automatic served +pages. + +=head2 dsl_class + +For complex applications that require extended DSL keywords or other +functionality the DSL class used can be specified at import time or in the +config settings. + + dsl_class: 'My::DSL' + +This is the same as specifying + + use Dancer2 dsl => 'My::DSL' + +in your module. dsl_class defaults to L<Dancer2::Core::DSL> if not specified + +=head2 Environment variables + +=head3 DANCER_CONFDIR + +Sets the configuration directory. + +This correlates to the C<confdir> config option. + +=head3 DANCER_ENVDIR + +Sets the environment directory. + +This correlates to the C<envdir> config option. + +=head3 PLACK_ENV + +Sets the given environment. This can be overridden by +C<DANCER_ENVIRONMENT>. + +=head3 DANCER_ENVIRONMENT + +Sets the given environment. This takes higher precedence over +C<PLACK_ENV>. + +If neither C<PLACK_ENV> or C<DANCER_ENVIRONMENT> is set, the environment +defaults to B<development>. + +=head3 DANCER_APPHANDLER + +The C<DANCER_APPHANDLER> configuration controls what the C<dance> keyword +does. + +If is set to C<PSGI> (which will automatically be set if C<PLACK_ENV> is +set), C<dance> will return the PSGI application coderef. + +Otherwise (which is the default is - C<Standalone>), it runs the Plack +standalone server with the application. + +=head3 DANCER_PORT + +Sets the port which will be used by the development server (if not run +by L<plackup>). + +=head3 DANCER_SERVER + +Sets the host the development server will be used by the development +server (if not run by L<plackup>). + +B<Note>: this might change in the future. + +=head3 DANCER_STARTUP_INFO + +Controls whether to display start up info. + +=head3 DANCER_NO_SERVER_TOKENS + +Controls whether to display the server tokens. + +=head3 DANCER_PUBLIC + +Sets the public directory location. + +=head3 DANCER_TRACES + +Sets the tracing flag which sets L<Carp>'s C<$Verbose> flag. + +=head3 DANCER_VIEWS + +Sets the views (templates) directory. + +=head3 DANCER_LOGGER + +Sets the logger engine. + +=head3 DANCER_CHARSET + +Sets the default charset. + +=head3 DANCER_CONTENT_TYPE + +Sets the default content type. + +If not set, defaults to B<text/html>. + +=head1 SEE ALSO + +L<Dancer2> + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Cookbook.pod b/lib/Dancer2/Cookbook.pod new file mode 100644 index 00000000..8fe2144b --- /dev/null +++ b/lib/Dancer2/Cookbook.pod @@ -0,0 +1,995 @@ +package Dancer2::Cookbook; +# ABSTRACT: Example-driven quick-start to the Dancer2 web framework + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Cookbook - Example-driven quick-start to the Dancer2 web framework + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +A quick-start guide with examples to get you up and running with the Dancer2 +web framework. This document will be twice as useful if you finish reading +the manual (L<Dancer2::Manual>) first, but that is not required... :-) + +=head1 BEGINNER'S DANCE + +=head2 A simple Dancer2 web app + +Dancer2 has been designed to be easy to work with - it's trivial to write a +simple web app, but still has the power to work with larger projects. To +start with, let's make an incredibly simple "Hello World" example: + + #!/usr/bin/env perl + + use Dancer2; + + get '/hello/:name' => sub { + return "Why, hello there " . route_parameters->get('name'); + }; + + dance; + +Yes - the above is a fully-functioning web app; running that script will +launch a webserver listening on the default port (3000). Now you can make a +request: + + $ curl http://localhost:3000/hello/Bob + Why, hello there Bob + +and it will say hello. The C<:name> part is a named parameter within the +route specification, whose value is made available through C<route_parameters>. + +Note that you don't need to use the C<strict> and C<warnings> pragmas; they +are already loaded by Dancer2. + +=head2 Default Route + +In case you want to avoid a I<404 error>, or handle multiple routes in the +same way and you don't feel like configuring all of them, you can set up a +default route handler. + +The default route handler will handle any request that doesn't get served by +any other route. + +All you need to do is set up the following route as the B<last> route: + + any qr{.*} => sub { + status 'not_found'; + template 'special_404', { path => request->path }; + }; + +Then you can set up the template like so: + + You tried to reach [% path %], but it is unavailable at the moment. + + Please try again or contact us at <contact@example.com>. + +=head2 Using the C<auto_page> feature for automatic route creation + +For simple "static" pages you can simply enable the C<auto_page> config +setting; this means you don't need to declare a route handler for those +pages; if a request is for C</foo/bar>, Dancer2 will check for a matching +view (e.g. C</foo/bar.tt>) and render it with the default layout, if +found. For full details, see the documentation for the L<auto_page +setting|Dancer2::Config/"auto_page">. + +=head2 Simplifying AJAX queries with the Ajax plugin + +As an AJAX query is just an HTTP query, it's similar to a GET or POST route. +You may ask yourself why you may want to use the C<ajax> keyword (from the +L<Dancer2::Plugin::Ajax> plugin) instead of a simple C<get>. + +Let's say you have a path like C</user/:user> in your application. You may +want to be able to serve this page with a layout and HTML content. But you +may also want to be able to call this same url from a javascript query using +AJAX. + +So, instead of having the following code: + + get '/user/:user' => sub { + if ( request->is_ajax ) { + # create xml, set headers to text/xml, blablabla + header( 'Content-Type' => 'text/xml' ); + header( 'Cache-Control' => 'no-store, no-cache, must-revalidate' ); + to_xml({...}) + } else { + template users => {...} + } + }; + +you can have + + ajax '/user/:user' => sub { + to_xml( {...}, RootName => undef ); + } + +and + + get '/user/:user' => sub { + template users => {...} + } + +Because it's an AJAX query, you know you need to return XML content, so +the content type of the response is set for you. + +=head3 Example: Feeding graph data through AJAX + +Let us assume we are building an application that uses a plotting library +to generate a graph and expects to get its data, which is in the form +of word count from an AJAX call. + +For the graph, we need the url I</data> to return a JSON representation +of the word count data. Dancer in fact has a C<encode_json()> function that takes +care of the JSON encapsulation. + + get '/data' => sub { + open my $fh, '<', $count_file; + + my %contestant; + while (<$fh>) { + chomp; + my ( $date, $who, $count ) = split '\s*,\s*'; + + my $epoch = DateTime::Format::Flexible->parse_datetime($date)->epoch; + my $time = 1000 * $epoch; + $contestant{$who}{$time} = $count; + } + + my @json; # data structure that is going to be JSONified + + while ( my ( $peep, $data ) = each %contestant ) { + push @json, { + label => $peep, + hoverable => \1, # so that it becomes JavaScript's 'true' + data => [ map { [ $_, $data->{$_} ] } + sort { $a <=> $b } + keys %$data ], + }; + } + + my $beginning = DateTime::Format::Flexible->parse_datetime( "2010-11-01")->epoch; + my $end = DateTime::Format::Flexible->parse_datetime( "2010-12-01")->epoch; + + push @json, { + label => 'de par', + data => [ + [$beginning * 1000, 0], + [ DateTime->now->epoch * 1_000, + 50_000 + * (DateTime->now->epoch - $beginning) + / ($end - $beginning) + ] + ], + + }; + + encode_json( \@json ); + }; + +For more serious AJAX interaction, there's also L<Dancer2::Plugin::Ajax> +that adds an I<ajax> route handler to the mix. + +Because it's an AJAX query, you know you need to return XML content, so +the content type of the response is set for you. + +=head2 Using the prefix feature to split your application + +For better maintainability, you may want to separate some of your application +components into different packages. Let's say we have a simple web app with an +admin section and want to maintain this in a different package: + + package myapp; + use Dancer2; + use myapp::admin; + + prefix undef; + + get '/' => sub {...}; + + 1; + + package myapp::admin; + use Dancer2 appname => 'myapp'; + + prefix '/admin'; + + get '/' => sub {...}; + + 1; + +The following routes will be generated for us: + + - get / + - get /admin/ + - head / + - head /admin/ + +By default, a separate application is created for every package that uses +Dancer2. The C<appname> tag is used to collect routes and hooks into a +single Dancer2 application. In the above example, C<appname =E<gt> 'myapp'> +adds the routes from C<myapp::admin> to the routes of the app C<myapp>. + +When using multiple applications please ensure that your path definitions do +not overlap. For example, if using a default route as described above, once +a request is matched to the default route then no further routes (or +applications) would be reached. + +=head2 Delivering custom error pages + +=head3 At the Core + +In Dancer2, creating new errors is done by creating a new L<Dancer2::Core::Error> + + my $oopsie = Dancer2::Core::Error->new( + status => 418, + message => "This is the Holidays. Tea not acceptable. We want eggnog.", + app => $app, + ) + +If not given, the status code defaults to a 500, there is no need for a message if +we feel taciturn, and while the C<$app> (which is a I<Dancer2::Core::App> +object holding all the pieces of information related to the current request) is +needed if we want to take advantage of the templates, we can also do without. + +However, to be seen by the end user, we have to populate the L<Dancer2::Core::Response> +object with the error's data. This is done via: + + $oopsie->throw($response); + +Or, if we want to use the response object already present in the C<$app> +(which is usually the case): + + $oopsie->throw; + +This populates the status code of the response, sets its content, and throws a +I<halt()> in the dispatch process. + +=head3 What it will look like + +The error object has quite a few ways to generate its content. + +First, it can be explicitly given + + my $oopsie = Dancer2::Core::Error->new( + content => '<html><body><h1>OMG</h1></body></html>', + ); + +If the C<$context> was given, the error will check if there is a +template by the name of the status code (so, say you're using Template +Toolkit, I<418.tt>) and will use it to generate the content, passing it +the error's C<$message>, C<$status> code and C<$title> (which, if not +specified, will be the standard http error definition for the status code). + +If there is no template, the error will then look for a static page (to +continue with our example, I<418.html>) in the I<public/> directory. + +And finally, if all of that failed, the error object will fall back on +an internal template. + +=head3 Errors in Routes + +The simplest way to use errors in routes is: + + get '/xmas/gift/:gift' => sub { + die "sorry, we're all out of ponies\n" + if route_parameters->get('gift') eq 'pony'; + }; + +The die will be intercepted by Dancer, converted into an error (status +code 500, message set to the dying words) and passed to the response. + +In the cases where more control is required, C<send_error()> is the way to go: + + get '/glass/eggnog' => sub { + send_error "Sorry, no eggnog here", 418; + }; + +And if total control is needed: + + get '/xmas/wishlist' => sub { + Dancer2::Core::Error->new( + response => response(), + status => 406, + message => "nothing but coal for you, I'm afraid", + template => 'naughty/index', + )->throw unless user_was_nice(); + + ...; + }; + +=head2 Template Toolkit's WRAPPER directive in Dancer2 + +Dancer2 already provides a WRAPPER-like ability, which we call a "layout". +The reason we don't use Template Toolkit's WRAPPER (which also makes us +incompatible with it) is because not all template systems support it. +In fact, most don't. + +However, you might want to use it, and be able to define META variables and +regular L<Template::Toolkit> variables. + +These few steps will get you there: + +=over 4 + +=item * Disable the layout in Dancer2 + +You can do this by simply commenting (or removing) the C<layout> +configuration in the config file. + +=item * Use the Template Toolkit template engine + +Change the configuration of the template to Template Toolkit: + + # in config.yml + template: "template_toolkit" + +=item * Tell the Template Toolkit engine which wrapper to use + + # in config.yml + # ... + engines: + template: + template_toolkit: + WRAPPER: layouts/main.tt + +=back + +Done! Everything will work fine out of the box, including variables and META +variables. + +However, disabling the internal layout it will also disable the hooks C<before_layout_render> and C<after_layout_render>. + +=head2 Customizing Template Toolkit in Dancer2 + +Please see L<Dancer2::Template::TemplateToolkit|Dancer2::Template::TemplateToolkit/"ADVANCED CUSTOMIZATION"> +for more details. + +=head2 Accessing configuration information from a separate script + +You may want to access your webapp's configuration from outside your +webapp. You could, of course, use the YAML module of your choice and load +your webapps's C<config.yml>, but chances are that this is not convenient. + +Use Dancer2 instead. You can simply use +the values from C<config.yml> and some additional default values: + + # bin/show_app_config.pl + use Dancer2; + printf "template: %s\n", config->{'template'}; # simple + printf "log: %s\n", config->{'log'}; # undef + +Note that C<< config->{log} >> should result in an uninitialized warning +on a default scaffold since the environment isn't loaded and +log is defined in the environment and not in C<config.yml>. Hence C<undef>. + +Dancer2 will load your C<config.yml> configuration file along with the +correct environment file located in your C<environments> directory. + +The environment is determined by two environment variables in the following +order: + +=over 4 + +=item * DANCER_ENVIRONMENT + +=item * PLACK_ENV + +=back + +If neither of those is set, it will default to loading the development +environment (typically C<$webapp/environment/development.yml>). + +If you wish to load a different environment, you need to override these +variables. + +You can call your script with the environment changed: + + $ PLACK_ENV=production perl bin/show_app_config.pl + +Or you can override them directly in the script (less recommended): + + BEGIN { $ENV{'DANCER_ENVIRONMENT'} = 'production' } + use Dancer2; + + ... + +=head2 Using DBIx::Class + +L<DBIx::Class>, also known as DBIC, is one of the many Perl ORM +(I<Object Relational Mapper>). It is easy to use DBIC in Dancer2 using the +L<Dancer2::Plugin::DBIC>. + +=head3 An example + +This example demonstrates a simple Dancer2 application that allows one to search +for authors or books. The application is connected to a database, that contains +authors, and their books. The website will have one single page with a form, +that allows one to query books or authors, and display the results. + +=head4 Creating the application + + $ dancer2 -a bookstore + +To use the Template Toolkit as the template engine, we specify it in the +configuration file: + + # add in bookstore/config.yml + template: template_toolkit + +=head4 Creating the view + +We need a view to display the search form, and below, the results, if any. The +results will be fed by the route to the view as an arrayref of results. Each +result is a I<hashref>, with a author key containing the name of the author, and +a books key containing an I<arrayref> of strings : the books names. + + # example of a list of results + [ { author => 'author 1', + books => [ 'book 1', 'book 2' ], + }, + { author => 'author 2', + books => [ 'book 3', 'book 4' ], + } + ] + + + # bookstore/views/search.tt + <p> + <form action="/search"> + Search query: <input type="text" name="query" /> + </form> + </p> + <br> + +An example of the view, displaying the search form, and the results, if any: + + <% IF query.length %> + <p>Search query was : <% query %>.</p> + <% IF results.size %> + Results: + <ul> + <% FOREACH result IN results %> + <li>Author: <% result.author.replace("((?i)$query)", '<b>$1</b>') %> + <ul> + <% FOREACH book IN result.books %> + <li><% book.replace("((?i)$query)", '<b>$1</b>') %> + <% END %> + </ul> + <% END %> + <% ELSE %> + No result + <% END %> + <% END %> + +=head4 Creating a Route + +A simple route, to be added in the I<bookstore.pm> module: + + # add in bookstore/lib/bookstore.pm + get '/search' => sub { + my $query = query_parameters->get('query'); + my @results = (); + + if ( length $query ) { + @results = _perform_search($query); + } + + template search => { + query => $query, + results => \@results, + }; + }; + +=head4 Creating a database + +We create a SQLite file database: + + $ sqlite3 bookstore.db + CREATE TABLE author( + id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + firstname text default '' not null, + lastname text not null); + + CREATE TABLE book( + id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + author INTEGER REFERENCES author (id), + title text default '' not null ); + +Now, to populate the database with some data, we use L<DBIx::Class>: + + # populate_database.pl + package My::Bookstore::Schema; + use base qw(DBIx::Class::Schema::Loader); + package main; + my $schema = My::Bookstore::Schema->connect('dbi:SQLite:dbname=bookstore.db'); + $schema->populate('Author', [ + [ 'firstname', 'lastname'], + [ 'Ian M.', 'Banks' ], + [ 'Richard', 'Matheson'], + [ 'Frank', 'Herbert' ], + ]); + my @books_list = ( + [ 'Consider Phlebas', 'Banks' ], + [ 'The Player of Games', 'Banks' ], + [ 'Use of Weapons', 'Banks' ], + [ 'Dune', 'Herbert' ], + [ 'Dune Messiah', 'Herbert' ], + [ 'Children of Dune', 'Herbert' ], + [ 'The Night Stalker', 'Matheson' ], + [ 'The Night Strangler', 'Matheson' ], + ); + # transform author names into ids + $_->[1] = $schema->resultset('Author')->find({ lastname => $_->[1] })->id + foreach (@books_list); + $schema->populate('Book', [ + [ 'title', 'author' ], + @books_list, + ]); + +Then run it in the directory where I<bookstore.db> sits: + + perl populate_database.db + +=head4 Using Dancer2::Plugin::DBIC + +There are 2 ways of configuring DBIC to understand how the data is organized +in your database: + +=over 4 + +=item * Use auto-detection + +The configuration file needs to be updated to indicate the use of the +Dancer2::Plugin::DBIC plugin, define a new DBIC schema called I<bookstore> and +to indicate that this schema is connected to the SQLite database we created. + + # add in bookstore/config.yml + plugins: + DBIC: + bookstore: + dsn: "dbi:SQLite:dbname=bookstore.db" + +Now, C<_perform_search> can be implemented using L<Dancer2::Plugin::DBIC>. The +plugin gives you access to an additional keyword called B<schema>, which you +give the name of schema you want to retrieve. It returns a C<DBIx::Class::Schema::Loader> +which can be used to get a resultset and perform searches, as per standard +usage of DBIX::Class. + + # add in bookstore/lib/bookstore.pm + sub _perform_search { + my ($query) = @_; + my $bookstore_schema = schema 'bookstore'; + my @results; + # search in authors + my @authors = $bookstore_schema->resultset('Author')->search({ + -or => [ + firstname => { like => "%$query%" }, + lastname => { like => "%$query%" }, + ] + }); + push @results, map { + { author => join(' ', $_->firstname, $_->lastname), + books => [], + } + } @authors; + my %book_results; + # search in books + my @books = $bookstore_schema->resultset('Book')->search({ + title => { like => "%$query%" }, + }); + foreach my $book (@books) { + my $author_name = join(' ', $book->author->firstname, $book->author->lastname); + push @{$book_results{$author_name}}, $book->title; + } + push @results, map { + { author => $_, + books => $book_results{$_}, + } + } keys %book_results; + return @results; + } + +=item * Use home made schema classes + +The L<DBIx::Class::MooseColumns> lets you write the DBIC schema classes +using L<Moose>. The schema classes should be put in a place that Dancer2 +will find. A good place is in I<bookstore/lib/>. + +Once your schema classes are in place, all you need to do is modify I<config.yml> +to specify that you want to use them, instead of the default auto-detection method: + + # change in bookstore/config.yml + plugins: + DBIC: + bookstore: + schema_class: My::Bookstore::Schema + dsn: "dbi:SQLite:dbname=bookstore.db" + +B<Starting the application>: +Our bookstore lookup application can now be started using the built-in server: + + # start the web application + plackup bin/app.psgi + +=back + +=head2 Authentication + +Writing a form for authentication is simple: we check the user credentials +on a request and decide whether to continue or redirect them to a form. +The form allows them to submit their username and password and we save that +and create a session for them so when they now try the original request, +we recognize them and allow them in. + +=head3 Basic Application + +The application is fairly simple. We have a route that needs authentication, +we have a route for showing the login page, and we have a route for posting +login information and creating a session. + + package MyApp; + use Dancer2; + + get '/' => sub { + session('user') + or redirect('/login'); + + template index => {}; + }; + + get '/login' => sub { + template login => {}; + }; + + post '/login' => sub { + my $username = query_parameters->get('username'); + my $password = query_parameters->get('password'); + my $redir_url = query_parameters->get('redirect_url') || '/login'; + + $username eq 'john' && $password eq 'correcthorsebatterystaple' + or redirect $redir_url; + + session user => $username; + redirect $redir_url; + }; + +=head3 Tiny Authentication Helper + +L<Dancer2::Plugin::Auth::Tiny> allows you to abstract away not only the +part that checks whether the session exists, but to also generate a +redirect with the right path and return URL. + +We simply have to define what routes needs a login using Auth::Tiny's +C<needs> keyword. + + get '/' => needs login => sub { + template index => {}; + }; + +It creates a proper return URL using C<uri_for> and the address from which +the user arrived. + +We can thus decorate all of our private routes to require authentication in +this manner. If a user does not have a session, it will automatically forward +it to I</login>, in which we would render a form for the user to send a login request. + +Auth::Tiny even provides a new parameter, C<return_url>, which can be used to send +the user back to their original requested path. + +=head3 Password Hashing + +L<Dancer2::Plugin::Passphrase> provides a simple passwords-as-objects interface with +sane defaults for hashed passwords which you can use in your web application. It uses +B<bcrypt> as the default but supports anything the L<Digest> interface does. + +Assuming we have the original user-creation form submitting a username and password: + + package MyApp; + use Dancer2; + use Dancer2::Plugin::Passphrase; + post '/register' => sub { + my $username = query_parameters->get('username'); + my $password = passphrase( + query_parameters->get('password') + )->generate; + + # $password is now a hashed password object + save_user_in_db( $username, $password->rfc2307 ); + + template registered => { success => 1 }; + }; + +We can now add the B<POST> method for verifying that username and password: + + post '/login' => sub { + my $username = query_parameters->get('username'); + my $password = query_parameters->get('password'); + my $saved_pass = fetch_password_from_db($username); + + if ( passphrase($password)->matches($saved_pass) ) { + session user => $username; + redirect query_parameters->get('return_url') || '/'; + } + + # let's render instead of redirect... + template login => { error => 'Invalid username or password' }; + }; + +=head2 Writing a REST application + +With Dancer2, it's easy to write REST applications. Dancer2 provides helpers +to serialize and deserialize for the following data formats: + +=over 4 + +=item JSON + +=item YAML + +=item XML + +=item Data::Dumper + +=back + +To activate this feature, you only have to set the C<serializer> setting to +the format you require, for instance in your config file: + + serializer: JSON + +Or directly in your code: + + set serializer => 'JSON'; + +From now, all hashrefs or arrayrefs returned by a route will be serialized +to the format you chose, and all data received from B<POST> or B<PUT> +requests will be automatically deserialized. + + get '/hello/:name' => sub { + # this structure will be returned to the client as + # {"name":"$name"} + return { name => query_parameters->get('name') }; + }; + +It's possible to let the client choose which serializer to use. For +this, use the C<mutable> serializer, and an appropriate serializer will be +chosen from the C<Content-Type> header. + +It's also possible to return a custom error using the +L<send_error|Dancer2::Manual/send_error> keyword. When you don't use a serializer, +the C<send_error> function will take a string as first parameter (the +message), and an optional HTTP code. When using a serializer, the message +can be a string, an arrayref or a hashref: + + get '/hello/:name' => sub { + if (...) { + send_error("you can't do that"); + # or + send_error({reason => 'access denied', message => "no"}); + } + }; + +The content of the error will be serialized using the appropriate +serializer. + +=head2 Using the serializer + +Serializers essentially do two things: + +=over 4 + +=item * Deserialize incoming requests + +When a user makes a request with serialized input, the serializer +automatically deserializes it into actual input parameters. + +=item * Serialize outgoing responses + +When you return a data structure from a route, it will automatically +serialize it for you before returning it to the user. + +=back + +=head3 Configuring + +In order to configure a serializer, you just need to pick which format +you want for encoding/decoding (e.g. L<JSON|Dancer2::Serializer::JSON>) +and set it up using the C<serializer> configuration keyword. + +It is recommended to explicitly add it in the actual code instead of the +configuration file so it doesn't apply automatically to every app that +reads the configuration file (unless that's what you want): + + package MyApp; + use Dancer2; + set serializer => 'JSON'; # Dancer2::Serializer::JSON + + ... + +=head3 Using + +Now that we have a serializer set up, we can just return data structures: + + get '/' => sub { + return { resources => \%resources }; + }; + +When we return this data structure, it will automatically be serialized +into JSON. No other code is necessary. + +We also now receive requests in JSON: + + post '/:entity/:id' => sub { + my $entity = route_parameters->get('entity'); + my $id = route_parameters->get('id'); + + # input which was sent serialized + my $user = body_parameters->get('user'); + + ... + }; + +We can now make a serialized request: + + $ curl -X POST http://ourdomain/person/16 -d '{"user":"sawyer_x"}' + +=head3 App-specific feature + +Serializers are engines. They affect a Dancer Application, which means +that once you've set a serializer, B<all> routes within that package +will be serialized and deserialized. This is how the feature works. + +As suggested above, if you would like to have both, you need to create +another application which will not be serialized. + +A common usage for this is an API providing serialized endpoints (and +receiving serialized requests) and providing rendered pages. + + # MyApp.pm + package MyApp; + use Dancer2; + + # another useful feature: + set auto_page => 1; + + get '/' => sub { template 'index' => {...} }; + + # MyApp/API.pm + package MyApp::API; + use Dancer2; + set serializer => 'JSON'; # or any other serializer + + get '/' => sub { +{ resources => \%resources, ... } }; + + # user-specific routes, for example + prefix '/users' => sub { + get '/view' => sub {...}; + get '/view/:id' => sub {...}; + put '/add' => sub {...}; # automatically deserialized params + }; + + ... + +Then those will be mounted together for a single app: + + # handler: app.pl: + use MyApp; + use MyApp::API; + use Plack::Builder; + + builder { + mount '/' => MyApp->to_app; + mount '/api' => MyApp::API->to_app; + }; + +If you want use redirect from a mounted package to the application's root +URI, L<Dancer2::Plugin::RootURIFor> makes this possible: + + package OurWiki; + use Dancer; + use Dancer2::Plugin::RootURIFor; + + get '/:some_path' => sub { + redirect root_uri_for('/'); + } + +=head3 An example: Writing API interfaces + +This example demonstrates an app that makes a request to a weather +API and then displays it dynamically in a web page. + +Other than L<Dancer2> for defining routes, we will use L<HTTP::Tiny> +to make the weather API request, L<JSON> to decode it from JSON format, +and finally L<File::Spec> to provide a fully-qualified path to our +template engine. + + use JSON; + use Dancer2; + use HTTP::Tiny; + use File::Spec; + +=head4 Configuration + +We use the L<Template::Toolkit> template system for this app. +Dancer searches for our templates in our views directory, which defaults +to I<views> directory in our current directory. Since we want to put our +template in our current directory, we will configure that. However, +I<Template::Toolkit> does not want us to provide a relative path without +configuring it to allow it. This is a security issue. So, we're using +L<File::Spec> to create a full path to where we are. + +We also unset the default layout, so Dancer won't try to wrap our template +with another one. This is a feature in Dancer to allow you to wrap your +templates with a layout when your templating system doesn't support it. Since +we're not using a layout here, we don't need it. + + set template => 'template_toolkit'; # set template engine + set layout => undef; # disable layout + set views => File::Spec->rel2abs('.'); # full path to views + +Now, we define our URL: + + my $url = 'http://api.openweathermap.org/data/2.5/weather?id=5110629&units=imperial'; + +=head4 Route + +We will define a main route which, upon a request, will fetch the information +from the weather API, decode it, and then display it to the user. + +Route definition: + + get '/' => sub { + ... + }; + +Editing the stub of route dispatching code, we start by making the request +and decoding it: + + # fetch data + my $res = HTTP::Tiny->new->get($url); + + # decode request + my $data = decode_json $res->{'content'}; + +The data is not just a flat hash. It's a deep structure. In this example, we +will filter it for only the simple keys in the retrieved data: + + my $metrics = { map +( + ref $data->{$_} ? () : ( $_ => $data->{$_} ) + ), keys %{$data} }; + +All that is left now is to render it: + + template index => { metrics => $metrics }; + +=head1 NON-STANDARD STEPS + +=head2 Turning off warnings + +The C<warnings> pragma is already used when one loads Dancer2. However, if +you I<really> do not want the C<warnings> pragma (for example, due to an +undesired warning about use of undef values), add a C<no warnings> pragma to +the appropriate block in your module or psgi file. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core.pm b/lib/Dancer2/Core.pm new file mode 100644 index 00000000..06af1a0d --- /dev/null +++ b/lib/Dancer2/Core.pm @@ -0,0 +1,51 @@ +package Dancer2::Core; +# ABSTRACT: Core libraries for Dancer2 2.0 +$Dancer2::Core::VERSION = '0.300000'; +use strict; +use warnings; + +sub camelize { + my ($value) = @_; + + my $camelized = ''; + for my $word ( split /_/, $value ) { + $camelized .= ucfirst($word); + } + return $camelized; +} + + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core - Core libraries for Dancer2 2.0 + +=head1 VERSION + +version 0.300000 + +=head1 FUNCTIONS + +=head2 camelize + +Camelize a underscore-separated-string. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/App.pm b/lib/Dancer2/Core/App.pm new file mode 100644 index 00000000..05a6ad90 --- /dev/null +++ b/lib/Dancer2/Core/App.pm @@ -0,0 +1,1902 @@ +# ABSTRACT: encapsulation of Dancer2 packages +package Dancer2::Core::App; +$Dancer2::Core::App::VERSION = '0.300000'; +use Moo; +use Carp qw<croak carp>; +use Scalar::Util 'blessed'; +use Module::Runtime 'is_module_name'; +use Safe::Isa; +use Sub::Quote; +use File::Spec; +use Module::Runtime 'use_module'; +use List::Util (); +use Ref::Util qw< is_ref is_globref is_scalarref >; + +use Plack::App::File; +use Plack::Middleware::FixMissingBodyInRedirect; +use Plack::Middleware::Head; +use Plack::Middleware::Conditional; +use Plack::Middleware::ConditionalGET; + +use Dancer2::FileUtils 'path'; +use Dancer2::Core; +use Dancer2::Core::Cookie; +use Dancer2::Core::Error; +use Dancer2::Core::Types; +use Dancer2::Core::Route; +use Dancer2::Core::Hook; +use Dancer2::Core::Request; +use Dancer2::Core::Factory; + +use Dancer2::Handler::File; + +our $EVAL_SHIM; $EVAL_SHIM ||= sub { + my $code = shift; + $code->(@_); +}; + + +# we have hooks here +with qw< + Dancer2::Core::Role::Hookable + Dancer2::Core::Role::ConfigReader +>; + +sub supported_engines { [ qw<logger serializer session template> ] } + +sub with_plugins { + my ( $self, @plugins ) = @_; + return map $self->_with_plugin($_), @plugins; + +} + +sub _with_plugin { + my( $self, $plugin ) = @_; + + if ( is_ref($plugin) ) { + # passing the plugin as an already-created object + + # already loaded? + if( my ( $already ) = grep { ref($plugin) eq ref $_; } @{ $self->plugins } ) { + die "trying to load two different objects for plugin ". ref $plugin + if refaddr($plugin) != refaddr $already ; + + } + else { + push @{ $self->plugins }, $plugin; + } + + return $plugin; + } + + # short plugin names get Dancer2::Plugin:: prefix + # plugin names starting with a '+' are full package names + if ( $plugin !~ s/^\+// ) { + $plugin =~ s/^(?!Dancer2::Plugin::)/Dancer2::Plugin::/; + } + + # check if it's already there + if( my ( $already ) = grep { $plugin eq ref $_ } @{ $self->plugins } ) { + return $already; + } + + push @{ $self->plugins }, + $plugin = use_module($plugin)->new( app => $self ); + + return $plugin; +} + +sub with_plugin { + my( $self, $plugin ) = @_; + + croak "expected a single argument" + unless @_ == 2; + + ( $self->with_plugins($plugin) )[0]; +} + +has _factory => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Factory'], + lazy => 1, + default => sub { Dancer2::Core::Factory->new }, +); + +has logger_engine => ( + is => 'ro', + isa => ConsumerOf['Dancer2::Core::Role::Logger'], + lazy => 1, + builder => '_build_logger_engine', + writer => 'set_logger_engine', +); + +has session_engine => ( + is => 'ro', + isa => ConsumerOf['Dancer2::Core::Role::SessionFactory'], + lazy => 1, + builder => '_build_session_engine', + writer => 'set_session_engine', +); + +has template_engine => ( + is => 'ro', + isa => ConsumerOf['Dancer2::Core::Role::Template'], + lazy => 1, + builder => '_build_template_engine', + writer => 'set_template_engine', +); + +has serializer_engine => ( + is => 'ro', + isa => ConsumerOf['Dancer2::Core::Role::Serializer'], + lazy => 1, + builder => '_build_serializer_engine', + writer => 'set_serializer_engine', + predicate => 'has_serializer_engine', +); + +has '+local_triggers' => ( + default => sub { + my $self = shift; + my $triggers = { + # general triggers we want to allow, besides engines + views => sub { + my $self = shift; + my $value = shift; + $self->template_engine->views($value); + }, + + layout => sub { + my $self = shift; + my $value = shift; + $self->template_engine->layout($value); + }, + + layout_dir => sub { + my $self = shift; + my $value = shift; + $self->template_engine->layout_dir($value); + }, + + log => sub { + my ( $self, $value, $config ) = @_; + + # This will allow to set the log level + # using: set log => warning + $self->logger_engine->log_level($value); + }, + }; + + foreach my $engine ( @{ $self->supported_engines } ) { + $triggers->{$engine} = sub { + my $self = shift; + my $value = shift; + my $config = shift; + + is_ref($value) and return $value; + + my $build_method = "_build_${engine}_engine"; + my $setter_method = "set_${engine}_engine"; + my $engine_instance = $self->$build_method( $value, $config ); + + # set the engine with the new value from the builder + $self->$setter_method($engine_instance); + + return $engine_instance; + }; + } + + return $triggers; + }, +); + +sub _build_logger_engine { + my $self = shift; + my $value = shift; + my $config = shift; + + defined $config or $config = $self->config; + defined $value or $value = $config->{logger}; + + is_ref($value) and return $value; + + # XXX This is needed for the tests that create an app without + # a runner. + defined $value or $value = 'console'; + + is_module_name($value) + or croak "Cannot load logger engine '$value': illegal module name"; + + my $engine_options = + $self->_get_config_for_engine( logger => $value, $config ); + + my $logger = $self->_factory->create( + logger => $value, + %{$engine_options}, + location => $self->config_location, + environment => $self->environment, + app_name => $self->name, + postponed_hooks => $self->postponed_hooks + ); + + exists $config->{log} and $logger->log_level($config->{log}); + + return $logger; +} + +sub _build_session_engine { + my $self = shift; + my $value = shift; + my $config = shift; + + defined $config or $config = $self->config; + defined $value or $value = $config->{'session'} || 'simple'; + + is_ref($value) and return $value; + + is_module_name($value) + or croak "Cannot load session engine '$value': illegal module name"; + + my $engine_options = + $self->_get_config_for_engine( session => $value, $config ); + + Scalar::Util::weaken( my $weak_self = $self ); + + # Note that engine options will replace the default session_dir (if provided). + return $self->_factory->create( + session => $value, + session_dir => path( $self->config->{appdir}, 'sessions' ), + %{$engine_options}, + postponed_hooks => $self->postponed_hooks, + + log_cb => sub { $weak_self->log(@_) }, + ); +} + +sub _build_template_engine { + my $self = shift; + my $value = shift; + my $config = shift; + + defined $config or $config = $self->config; + defined $value or $value = $config->{'template'}; + + defined $value or return; + is_ref($value) and return $value; + + is_module_name($value) + or croak "Cannot load template engine '$value': illegal module name"; + + my $engine_options = + $self->_get_config_for_engine( template => $value, $config ); + + my $engine_attrs = { config => $engine_options }; + $engine_attrs->{layout} ||= $config->{layout}; + $engine_attrs->{views} ||= $config->{views} + || path( $self->location, 'views' ); + $engine_attrs->{layout_dir} ||= $config->{layout_dir} + || 'layouts'; + + Scalar::Util::weaken( my $weak_self = $self ); + + return $self->_factory->create( + template => $value, + %{$engine_attrs}, + postponed_hooks => $self->postponed_hooks, + + log_cb => sub { $weak_self->log(@_) }, + ); +} + +sub _build_serializer_engine { + my $self = shift; + my $value = shift; + my $config = shift; + + defined $config or $config = $self->config; + defined $value or $value = $config->{serializer}; + + defined $value or return; + is_ref($value) and return $value; + + my $engine_options = + $self->_get_config_for_engine( serializer => $value, $config ); + + Scalar::Util::weaken( my $weak_self = $self ); + + return $self->_factory->create( + serializer => $value, + config => $engine_options, + postponed_hooks => $self->postponed_hooks, + + log_cb => sub { $weak_self->log(@_) }, + ); +} + +sub _get_config_for_engine { + my $self = shift; + my $engine = shift; + my $name = shift; + my $config = shift; + + defined $config->{'engines'} && defined $config->{'engines'}{$engine} + or return {}; + + # try both camelized name and regular name + my $engine_config = {}; + foreach my $engine_name ( $name, Dancer2::Core::camelize($name) ) { + if ( defined $config->{'engines'}{$engine}{$engine_name} ) { + $engine_config = $config->{'engines'}{$engine}{$engine_name}; + last; + } + } + + return $engine_config; +} + +has postponed_hooks => ( + is => 'ro', + isa => HashRef, + default => sub { {} }, +); + +# TODO I'd be happier with a HashRef, really +has plugins => ( + is => 'rw', + isa => ArrayRef, + default => sub { [] }, +); + +has route_handlers => ( + is => 'rw', + isa => ArrayRef, + default => sub { [] }, +); + +has name => ( + is => 'ro', + isa => Str, + default => sub { (caller(1))[0] }, +); + +has request => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Request'], + writer => '_set_request', + clearer => 'clear_request', + predicate => 'has_request', +); + +sub set_request { + my ($self, $request, $defined_engines) = @_; + # typically this is passed in as an optimization within the + # dispatch loop but may be called elsewhere + $defined_engines ||= $self->defined_engines; + # populate request in app and all engines + $self->_set_request($request); + Scalar::Util::weaken( my $weak_request = $request ); + $_->set_request( $weak_request ) for @{$defined_engines}; +} + +has response => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Response'], + lazy => 1, + writer => 'set_response', + clearer => 'clear_response', + builder => '_build_response', + predicate => 'has_response', +); + +has with_return => ( + is => 'ro', + predicate => 1, + writer => 'set_with_return', + clearer => 'clear_with_return', +); + +has session => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Session'], + lazy => 1, + builder => '_build_session', + writer => 'set_session', + clearer => 'clear_session', + predicate => '_has_session', +); + +around _build_config => sub { + my ( $orig, $self ) = @_; + my $config = $self->$orig; + + if ( $config && $config->{'engines'} ) { + $self->_validate_engine($_) for keys %{ $config->{'engines'} }; + } + + return $config; +}; + +sub _build_response { + my $self = shift; + return Dancer2::Core::Response->new( + server_tokens => !$self->config->{'no_server_tokens'}, + $self->has_serializer_engine + ? ( serializer => $self->serializer_engine ) + : (), + ); +} + +sub _build_session { + my $self = shift; + my $session; + + # Find the session engine + my $engine = $self->session_engine; + + # find the session cookie if any + if ( !$self->has_destroyed_session ) { + my $session_id; + my $session_cookie = $self->cookie( $engine->cookie_name ); + defined $session_cookie and + $session_id = $session_cookie->value; + + # if we have a session cookie, try to retrieve the session + if ( defined $session_id ) { + eval { + $EVAL_SHIM->(sub { + $session = $engine->retrieve( id => $session_id ); + }); + 1; + } + or do { + my $err = $@ || "Zombie Error"; + if ( $err !~ /Unable to retrieve session/ ) { + croak "Failed to retrieve session: $err" + } else { + # XXX we throw away the error entirely? Why? + } + }; + } + } + + # create the session if none retrieved + return $session ||= $engine->create(); +} + +sub has_session { + my $self = shift; + + my $engine = $self->session_engine; + + return $self->_has_session + || ( $self->cookie( $engine->cookie_name ) + && !$self->has_destroyed_session ); +} + +has destroyed_session => ( + is => 'ro', + isa => InstanceOf ['Dancer2::Core::Session'], + predicate => 1, + writer => 'set_destroyed_session', + clearer => 'clear_destroyed_session', +); + +has 'prep_apps' => ( + 'is' => 'ro', + 'isa' => ArrayRef, + 'default' => sub { [] }, +); + +sub find_plugin { + my ( $self, $name ) = @_; + my $plugin = List::Util::first { ref($_) eq $name } @{ $self->plugins }; + $plugin or return; + return $plugin; +} + +sub destroy_session { + my $self = shift; + + # Find the session engine + my $engine = $self->session_engine; + + # Expire session, set the expired cookie and destroy the session + # Setting the cookie ensures client gets an expired cookie unless + # a new session is created and supercedes it + my $session = $self->session; + $session->expires(-86400); # yesterday + $engine->destroy( id => $session->id ); + + # Invalidate session cookie in request + # and clear session in app and engines + $self->set_destroyed_session($session); + $self->clear_session; + $_->clear_session for @{ $self->defined_engines }; + + return; +} + +sub setup_session { + my $self = shift; + + for my $engine ( @{ $self->defined_engines } ) { + $self->has_session ? + $engine->set_session( $self->session ) : + $engine->clear_session; + } +} + +sub change_session_id { + my $self = shift; + + my $session = $self->session; + + # Find the session engine + my $engine = $self->session_engine; + + if ($engine->can('_change_id')) { + + # session engine can change session ID + $engine->change_id( session => $session ); + } + else { + + # Method order is important in here... + # + # On session build if there is no destroyed session then the session + # builder tries to recreate the session using the existing session + # cookie. We really don't want to do that in this case so it is + # important to create the new session before the + # clear_destroyed_session method is called. + # + # This sucks. + # + # Sawyer suggested: + # + # What if you take the session cookie logic out of that attribute into + # another attribute and clear that attribute? + # That would force the session rebuilt to rebuilt the attribute and + # get a different cookie value, no? + # + # TODO: think about this some more. + + # grab data, destroy session and store data again + my %data = %{$session->data}; + + # destroy existing session + $self->destroy_session; + + # get new session + $session = $self->session; + + # write data from old session into new + # Some engines add session id to data so skip id. + while (my ($key, $value) = each %data ) { + $session->write($key => $value) unless $key eq 'id'; + } + + # clear out destroyed session - no longer relevant + $self->clear_destroyed_session; + } + + return $session->id; +} + +has prefix => ( + is => 'rw', + isa => Maybe [Dancer2Prefix], + predicate => 1, + coerce => sub { + my $prefix = shift; + defined($prefix) and $prefix eq "/" and return; + return $prefix; + }, +); + +# routes registry, stored by method: +has routes => ( + is => 'rw', + isa => HashRef, + default => sub { + { get => [], + head => [], + post => [], + put => [], + del => [], + options => [], + }; + }, +); + +# add_hook will add the hook to the first "hook candidate" it finds that support +# it. If none, then it will try to add the hook to the current application. +around add_hook => sub { + my $orig = shift; + my $self = shift; + + # saving caller information + my ( $package, $file, $line ) = caller(4); # deep to 4 : user's app code + my $add_hook_caller = [ $package, $file, $line ]; + + my ($hook) = @_; + my $name = $hook->name; + my $hook_aliases = $self->all_hook_aliases; + + # look for an alias + defined $hook_aliases->{$name} and $name = $hook_aliases->{$name}; + $hook->name($name); + + # if that hook belongs to the app, register it now and return + $self->has_hook($name) and return $self->$orig(@_); + + # at this point the hook name must be formatted like: + # '$type.$candidate.$name', eg: 'engine.template.before_render' or + # 'plugin.database.before_dbi_connect' + my ( $hookable_type, $hookable_name, $hook_name ) = split( /\./, $name ); + + ( defined $hookable_name && defined $hook_name ) + or croak "Invalid hook name `$name'"; + + grep /^$hookable_type$/, qw(core engine handler plugin) + or croak "Unknown hook type `$hookable_type'"; + + # register the hooks for existing hookable candidates + foreach my $hookable ( $self->hook_candidates ) { + $hookable->has_hook($name) and $hookable->add_hook(@_); + } + + # we register the hook for upcoming objects; + # that way, each components that can claim the hook will have a chance + # to register it. + + my $postponed_hooks = $self->postponed_hooks; + + # Hmm, so the hook was not claimed, at this point we'll cache it and + # register it when the owner is instantiated + $postponed_hooks->{$hookable_type}{$hookable_name} ||= {}; + $postponed_hooks->{$hookable_type}{$hookable_name}{$name} ||= {}; + $postponed_hooks->{$hookable_type}{$hookable_name}{$name}{hook} = $hook; + $postponed_hooks->{$hookable_type}{$hookable_name}{$name}{caller} = + $add_hook_caller; + +}; + +around execute_hook => sub { + my $orig = shift; + my $self = shift; + + local $Dancer2::Core::Route::REQUEST = $self->request; + local $Dancer2::Core::Route::RESPONSE = $self->response; + + my ( $hook, @args ) = @_; + if ( !$self->has_hook($hook) ) { + foreach my $cand ( $self->hook_candidates ) { + $cand->has_hook($hook) and return $cand->execute_hook(@_); + } + } + + return $self->$orig(@_); +}; + +sub _build_default_config { + my $self = shift; + + my $public = $ENV{DANCER_PUBLIC} || path( $self->location, 'public' ); + return { + content_type => ( $ENV{DANCER_CONTENT_TYPE} || 'text/html' ), + charset => ( $ENV{DANCER_CHARSET} || '' ), + logger => ( $ENV{DANCER_LOGGER} || 'console' ), + views => ( $ENV{DANCER_VIEWS} + || path( $self->config_location, 'views' ) ), + environment => $self->environment, + appdir => $self->location, + public_dir => $public, + template => 'Tiny', + route_handlers => [ + [ + AutoPage => 1 + ], + ], + }; +} + +sub _init_hooks { + my $self = shift; + + # Hook to flush the session at the end of the request, + # this way, we're sure we flush only once per request + # + # Note: we create a weakened copy $self + # before closing over the weakened copy + # to avoid circular memory refs. + Scalar::Util::weaken(my $app = $self); + + $self->add_hook( + Dancer2::Core::Hook->new( + name => 'core.app.after_request', + code => sub { + my $response = $Dancer2::Core::Route::RESPONSE; + + # make sure an engine is defined, if not, nothing to do + my $engine = $app->session_engine; + defined $engine or return; + + # if a session has been instantiated or we already had a + # session, first flush the session so cookie-based sessions can + # update the session ID if needed, then set the session cookie + # in the response + # + # if there is NO session object but the request has a cookie with + # a session key, create a dummy session with the same ID (without + # actually retrieving and flushing immediately) and generate the + # cookie header from the dummy session. Lazy Sessions FTW! + + if ( $app->has_session ) { + my $session; + if ( $app->_has_session ) { # Session object exists + $session = $app->session; + $session->is_dirty and $engine->flush( session => $session ); + } + else { # Cookie header exists. Create a dummy session object + my $cookie = $app->cookie( $engine->cookie_name ); + my $session_id = $cookie->value; + $session = Dancer2::Core::Session->new( id => $session_id ); + } + $engine->set_cookie_header( + response => $response, + session => $session + ); + } + elsif ( $app->has_destroyed_session ) { + my $session = $app->destroyed_session; + $engine->set_cookie_header( + response => $response, + session => $session, + destroyed => 1 + ); + } + }, + ) + ); +} + +sub supported_hooks { + qw/ + core.app.before_request + core.app.after_request + core.app.route_exception + core.app.before_file_render + core.app.after_file_render + core.error.before + core.error.after + core.error.init + /; +} + +sub hook_aliases { + my $self = shift; + $self->{'hook_aliases'} ||= { + before => 'core.app.before_request', + before_request => 'core.app.before_request', + after => 'core.app.after_request', + after_request => 'core.app.after_request', + init_error => 'core.error.init', + before_error => 'core.error.before', + after_error => 'core.error.after', + on_route_exception => 'core.app.route_exception', + + before_file_render => 'core.app.before_file_render', + after_file_render => 'core.app.after_file_render', + before_handler_file_render => 'handler.file.before_render', + after_handler_file_render => 'handler.file.after_render', + + + # compatibility from Dancer1 + before_error_render => 'core.error.before', + after_error_render => 'core.error.after', + before_error_init => 'core.error.init', + + # TODO: call $engine->hook_aliases as needed + # But.. currently there are use cases where hook_aliases + # are needed before the engines are intiialized :( + before_template_render => 'engine.template.before_render', + after_template_render => 'engine.template.after_render', + before_layout_render => 'engine.template.before_layout_render', + after_layout_render => 'engine.template.after_layout_render', + before_serializer => 'engine.serializer.before', + after_serializer => 'engine.serializer.after', + }; +} + +sub defined_engines { + my $self = shift; + return [ + $self->template_engine, + $self->session_engine, + $self->logger_engine, + $self->has_serializer_engine + ? $self->serializer_engine + : (), + ]; +} + +# FIXME not needed anymore, I suppose... +sub api_version {2} + +sub register_plugin { + my $self = shift; + my $plugin = shift; + + $self->log( core => "Registered $plugin"); + + push @{ $self->plugins }, $plugin; +} + +# This method overrides the default one from Role::ConfigReader +sub settings { + my $self = shift; + +{ %{ Dancer2::runner()->config }, %{ $self->config } }; +} + +sub cleanup { + my $self = shift; + $self->clear_request; + $self->clear_response; + $self->clear_session; + $self->clear_destroyed_session; + # Clear engine attributes + for my $engine ( @{ $self->defined_engines } ) { + $engine->clear_session; + $engine->clear_request; + } +} + +sub _validate_engine { + my $self = shift; + my $name = shift; + + grep +( $_ eq $name ), @{ $self->supported_engines } + or croak "Engine '$name' is not supported."; +} + +sub engine { + my $self = shift; + my $name = shift; + + $self->_validate_engine($name); + + my $attr_name = "${name}_engine"; + return $self->$attr_name; +} + +sub template { + my $self = shift; + + my $template = $self->template_engine; + $template->set_settings( $self->config ); + + # A session will not exist if there is no request (global keyword) + # + # A session may exist but the route code may not have instantiated + # the session object (sessions are lazy). If this is the case, do + # that now, so the templates have the session data for rendering. + $self->has_request && $self->has_session && ! $template->has_session + and $self->setup_session; + + # return content + return $template->process( @_ ); +} + +sub hook_candidates { + my $self = shift; + + my @engines = @{ $self->defined_engines }; + + my @route_handlers; + for my $handler ( @{ $self->route_handlers } ) { + my $handler_code = $handler->{handler}; + blessed $handler_code and $handler_code->can('supported_hooks') + and push @route_handlers, $handler_code; + } + + # TODO : get the list of all plugins registered + my @plugins = @{ $self->plugins }; + + ( @route_handlers, @engines, @plugins ); +} + +sub all_hook_aliases { + my $self = shift; + + my $aliases = $self->hook_aliases; + for my $plugin ( grep { $_->can('hook_aliases') } @{ $self->plugins } ) { + $aliases = { %{$aliases}, %{ $plugin->hook_aliases } }; + } + + return $aliases; +} + +sub mime_type { + my $self = shift; + my $runner = Dancer2::runner(); + + exists $self->config->{default_mime_type} + ? $runner->mime_type->default( $self->config->{default_mime_type} ) + : $runner->mime_type->reset_default; + + $runner->mime_type; +} + +sub log { + my $self = shift; + my $level = shift; + + my $logger = $self->logger_engine + or croak "No logger defined"; + + $logger->$level(@_); +} + +sub send_as { + my $self = shift; + my ( $type, $data, $options ) = @_; + $options ||= {}; + + $type or croak "Can not send_as using an undefined type"; + + if ( lc($type) eq 'html' || lc($type) eq 'plain' ) { + if ( $type ne lc $type ) { + local $Carp::CarpLevel = 2; + carp sprintf( "Please use %s as the type for 'send_as', not %s", lc($type), $type ); + } + + $options->{charset} = $self->config->{charset} || 'UTF-8'; + my $content = Encode::encode( $options->{charset}, $data ); + $options->{content_type} ||= join '/', 'text', lc $type; + $self->send_file( \$content, %$options ); # returns from sub + } + + # Try and load the serializer class + my $serializer_class = "Dancer2::Serializer::$type"; + eval { + $EVAL_SHIM->(sub { + require_module( $serializer_class ); + }); + 1; + } or do { + my $err = $@ || "Zombie Error"; + croak "Unable to load serializer class for $type: $err"; + }; + + # load any serializer engine config + my $engine_options = + $self->_get_config_for_engine( serializer => $type, $self->config ) || {}; + my $serializer = $serializer_class->new( config => $engine_options ); + my $content = $serializer->serialize( $data ); + $options->{content_type} ||= $serializer->content_type; + $self->send_file( \$content, %$options ); +} + +sub send_error { + my $self = shift; + my ( $message, $status ) = @_; + + my $err = Dancer2::Core::Error->new( + message => $message, + app => $self, + ( status => $status )x!! $status, + + $self->has_serializer_engine + ? ( serializer => $self->serializer_engine ) + : (), + )->throw; + + # Immediately return to dispatch if with_return coderef exists + $self->has_with_return && $self->with_return->($err); + return $err; +} + +sub send_file { + my $self = shift; + my $thing = shift; + my %options = @_; + + my ($content_type, $charset, $file_path); + + # are we're given a filehandle? (based on what Plack::Middleware::Lint accepts) + my $is_filehandle = Plack::Util::is_real_fh($thing) + || ( is_globref($thing) && *{$thing}{IO} && *{$thing}{IO}->can('getline') ) + || ( Scalar::Util::blessed($thing) && $thing->can('getline') ); + my ($fh) = ($thing)x!! $is_filehandle; + + # if we're given an IO::Scalar object, DTRT (take the scalar ref from it) + if (Scalar::Util::blessed($thing) && $thing->isa('IO::Scalar')) { + $thing = $thing->sref; + } + + # if we're given a SCALAR reference, build a filehandle to it + if ( is_scalarref($thing) ) { + ## no critic qw(InputOutput::RequireCheckedOpen) + open $fh, "<", $thing; + } + + # If we haven't got a filehandle, create one to the requested content + if (! $fh) { + my $path = $thing; + # remove prefix from given path (if not a filehandle) + my $prefix = $self->prefix; + if ( $prefix && $prefix ne '/' ) { + $path =~ s/^\Q$prefix\E//; + } + # static file dir - either system root or public_dir + my $dir = $options{system_path} + ? File::Spec->rootdir + : $ENV{DANCER_PUBLIC} + || $self->config->{public_dir} + || path( $self->location, 'public' ); + + $file_path = Dancer2::Handler::File->merge_paths( $path, $dir ); + my $err_response = sub { + my $status = shift; + $self->response->status($status); + $self->response->header( 'Content-Type', 'text/plain' ); + $self->response->content( Dancer2::Core::HTTP->status_message($status) ); + $self->with_return->( $self->response ); + }; + $err_response->(403) if !defined $file_path; + $err_response->(404) if !-f $file_path; + $err_response->(403) if !-r $file_path; + + # Read file content as bytes + $fh = Dancer2::FileUtils::open_file( "<", $file_path ); + binmode $fh; + $content_type = Dancer2::runner()->mime_type->for_file($file_path) || 'text/plain'; + if ( $content_type =~ m!^text/! ) { + $charset = $self->config->{charset} || "utf-8"; + } + } + + # Now we are sure we can render the file... + $self->execute_hook( 'core.app.before_file_render', $file_path ); + + # response content type and charset + ( exists $options{'content_type'} ) and $content_type = $options{'content_type'}; + ( exists $options{'charset'} ) and $charset = $options{'charset'}; + $content_type .= "; charset=$charset" if $content_type and $charset; + ( defined $content_type ) + and $self->response->header('Content-Type' => $content_type ); + + # content disposition + ( exists $options{filename} ) + and $self->response->header( 'Content-Disposition' => + ($options{content_disposition} || "attachment") . "; filename=\"$options{filename}\"" ); + + # use a delayed response unless server does not support streaming + my $use_streaming = exists $options{streaming} ? $options{streaming} : 1; + my $response; + my $env = $self->request->env; + if ( $env->{'psgi.streaming'} && $use_streaming ) { + my $cb = sub { + my $responder = $Dancer2::Core::Route::RESPONDER; + my $res = $Dancer2::Core::Route::RESPONSE; + return $responder->( + [ $res->status, $res->headers_to_array, $fh ] + ); + }; + + Scalar::Util::weaken( my $weak_self = $self ); + + $response = Dancer2::Core::Response::Delayed->new( + error_cb => sub { $weak_self->logger_engine->log( warning => @_ ) }, + cb => $cb, + request => $Dancer2::Core::Route::REQUEST, + response => $Dancer2::Core::Route::RESPONSE, + ); + } + else { + $response = $self->response; + # direct assignment to hash element, avoids around modifier + # trying to serialise this this content. + $response->{content} = Dancer2::FileUtils::read_glob_content($fh); + $response->is_encoded(1); # bytes are already encoded + } + + $self->execute_hook( 'core.app.after_file_render', $response ); + $self->with_return->( $response ); +} + +sub BUILD { + my $self = shift; + $self->init_route_handlers(); + $self->_init_hooks(); +} + +sub finish { + my $self = shift; + + # normalize some values that require calculations + defined $self->config->{'static_handler'} + or $self->config->{'static_handler'} = -d $self->config->{'public_dir'}; + + $self->register_route_handlers; + $self->compile_hooks; + + @{$self->plugins} + && $self->plugins->[0]->can('_add_postponed_plugin_hooks') + && $self->plugins->[0]->_add_postponed_plugin_hooks( + $self->postponed_hooks + ); + + foreach my $prep_cb ( @{ $self->prep_apps } ) { + $prep_cb->($self); + } +} + +sub init_route_handlers { + my $self = shift; + + my $handlers_config = $self->config->{route_handlers}; + for my $handler_data ( @{$handlers_config} ) { + my ($handler_name, $config) = @{$handler_data}; + $config = {} if !is_ref($config); + + my $handler = $self->_factory->create( + Handler => $handler_name, + app => $self, + %$config, + postponed_hooks => $self->postponed_hooks, + ); + + push @{ $self->route_handlers }, { + name => $handler_name, + handler => $handler, + }; + } +} + +sub register_route_handlers { + my $self = shift; + for my $handler ( @{$self->route_handlers} ) { + my $handler_code = $handler->{handler}; + $handler_code->register($self); + } +} + +sub compile_hooks { + my ($self) = @_; + + for my $position ( $self->supported_hooks ) { + my $compiled_hooks = []; + for my $hook ( @{ $self->hooks->{$position} } ) { + Scalar::Util::weaken( my $app = $self ); + my $compiled = sub { + # don't run the filter if halt has been used + $Dancer2::Core::Route::RESPONSE && + $Dancer2::Core::Route::RESPONSE->is_halted + and return; + + eval { $EVAL_SHIM->($hook,@_); 1; } + or do { + my $err = $@ || "Zombie Error"; + $app->cleanup; + $app->log('error', "Exception caught in '$position' filter: $err"); + croak "Exception caught in '$position' filter: $err"; + }; + }; + + push @{$compiled_hooks}, $compiled; + } + $self->replace_hook( $position, $compiled_hooks ); + } +} + +sub lexical_prefix { + my $self = shift; + my $prefix = shift; + my $cb = shift; + + $prefix eq '/' and undef $prefix; + + # save the app prefix + my $app_prefix = $self->prefix; + + # alter the prefix for the callback + my $new_prefix = + ( defined $app_prefix ? $app_prefix : '' ) + . ( defined $prefix ? $prefix : '' ); + + # if the new prefix is empty, it's a meaningless prefix, just ignore it + length $new_prefix and $self->prefix($new_prefix); + + my $err; + my $ok= eval { $EVAL_SHIM->($cb); 1 } + or do { $err = $@ || "Zombie Error"; }; + + # restore app prefix + $self->prefix($app_prefix); + + $ok or croak "Unable to run the callback for prefix '$prefix': $err"; +} + +sub add_route { + my $self = shift; + my %route_attrs = @_; + + my $route = Dancer2::Core::Route->new( + type_library => $self->config->{type_library}, + %route_attrs, + prefix => $self->prefix, + ); + + my $method = $route->method; + + push @{ $self->routes->{$method} }, $route; + + return $route; +} + +sub route_exists { + my $self = shift; + my $route = shift; + + my $routes = $self->routes->{ $route->method }; + + foreach my $existing_route (@$routes) { + $existing_route->spec_route eq $route->spec_route + and return 1; + } + + return 0; +} + +sub routes_regexps_for { + my $self = shift; + my $method = shift; + + return [ map $_->regexp, @{ $self->routes->{$method} } ]; +} + +sub cookie { + my $self = shift; + + @_ == 1 and return $self->request->cookies->{ $_[0] }; + + # writer + my ( $name, $value, %options ) = @_; + my $c = + Dancer2::Core::Cookie->new( name => $name, value => $value, %options ); + $self->response->push_header( 'Set-Cookie' => $c->to_header ); +} + +sub redirect { + my $self = shift; + my $destination = shift; + my $status = shift; + + # RFC 2616 requires an absolute URI with a scheme, + # turn the URI into that if it needs it + + # Scheme grammar as defined in RFC 2396 + # scheme = alpha *( alpha | digit | "+" | "-" | "." ) + my $scheme_re = qr{ [a-z][a-z0-9\+\-\.]* }ix; + if ( $destination !~ m{^ $scheme_re : }x ) { + $destination = $self->request->uri_for( $destination, {}, 1 ); + } + + $self->response->redirect( $destination, $status ); + + # Short circuit any remaining before hook / route code + # ('pass' and after hooks are still processed) + $self->has_with_return + and $self->with_return->($self->response); +} + +sub halt { + my $self = shift; + $self->response->halt( @_ ); + + # Short citcuit any remaining hook/route code + $self->has_with_return + and $self->with_return->($self->response); +} + +sub pass { + my $self = shift; + $self->response->pass; + + # Short citcuit any remaining hook/route code + $self->has_with_return + and $self->with_return->($self->response); +} + +sub forward { + my $self = shift; + my $url = shift; + my $params = shift; + my $options = shift; + + my $new_request = $self->make_forward_to( $url, $params, $options ); + + $self->has_with_return + and $self->with_return->($new_request); + + # nothing else will run after this +} + +# Create a new request which is a clone of the current one, apart +# from the path location, which points instead to the new location +sub make_forward_to { + my $self = shift; + my $url = shift; + my $params = shift; + my $options = shift; + + my $overrides = { PATH_INFO => $url }; + exists $options->{method} and + $overrides->{REQUEST_METHOD} = $options->{method}; + + # "clone" the existing request + my $new_request = $self->request->_shallow_clone( $params, $overrides ); + + # If a session object was created during processing of the original request + # i.e. a session object exists but no cookie existed + # add a cookie so the dispatcher can assign the session to the appropriate app + my $engine = $self->session_engine; + $engine && $self->_has_session or return $new_request; + my $name = $engine->cookie_name; + exists $new_request->cookies->{$name} and return $new_request; + $new_request->cookies->{$name} = + Dancer2::Core::Cookie->new( name => $name, value => $self->session->id ); + + return $new_request; +} + +sub app { shift } + +# DISPATCHER +sub to_app { + my $self = shift; + + # build engines + { + for ( qw<logger session template> ) { + my $attr = "${_}_engine"; + $self->$attr; + } + + # the serializer engine does not have a default + # and is the only engine that can actually not have a value + if ( $self->config->{'serializer'} ) { + $self->serializer_engine; + } + } + + $self->finish; + + my $psgi = sub { + my $env = shift; + + # pre-request sanity check + my $method = uc $env->{'REQUEST_METHOD'}; + $Dancer2::Core::Types::supported_http_methods{$method} + or return [ + 405, + [ 'Content-Type' => 'text/plain' ], + [ "Method Not Allowed\n\n$method is not supported." ] + ]; + + my $response; + eval { + $EVAL_SHIM->(sub{ $response = $self->dispatch($env)->to_psgi }); + 1; + } or do { + my $err = $@ || "Zombie Error"; + return [ + 500, + [ 'Content-Type' => 'text/plain' ], + [ "Internal Server Error\n\n$err" ], + ]; + }; + + return $response; + }; + + # Only add static content handler if required + if ( $self->config->{'static_handler'} ) { + # Use App::File to "serve" the static content + my $static_app = Plack::App::File->new( + root => $self->config->{public_dir}, + content_type => sub { $self->mime_type->for_name(shift) }, + )->to_app; + # Conditionally use the static handler wrapped with ConditionalGET + # when the file exists. Otherwise the request passes into our app. + $psgi = Plack::Middleware::Conditional->wrap( + $psgi, + condition => sub { -f path( $self->config->{public_dir}, shift->{PATH_INFO} ) }, + builder => sub { Plack::Middleware::ConditionalGET->wrap( $static_app ) }, + ); + } + + # Wrap with common middleware + if ( ! $self->config->{'no_default_middleware'} ) { + # FixMissingBodyInRedirect + $psgi = Plack::Middleware::FixMissingBodyInRedirect->wrap( $psgi ); + # Apply Head. After static so a HEAD request on static content DWIM. + $psgi = Plack::Middleware::Head->wrap( $psgi ); + } + + return $psgi; +} + +sub dispatch { + my $self = shift; + my $env = shift; + + my $runner = Dancer2::runner(); + my $request = $runner->{'internal_request'} || + $self->build_request($env); + my $cname = $self->session_engine->cookie_name; + + my $defined_engines = $self->defined_engines; + +DISPATCH: + while (1) { + my $http_method = lc $request->method; + my $path_info = $request->path_info; + + # Add request to app and engines + $self->set_request($request, $defined_engines); + + $self->log( core => "looking for $http_method $path_info" ); + + ROUTE: + foreach my $route ( @{ $self->routes->{$http_method} } ) { + #warn "testing route " . $route->regexp . "\n"; + # TODO store in route cache + + # go to the next route if no match + my $match = $route->match($request) + or next ROUTE; + + $request->_set_route_params($match); + $request->_set_route_parameters($match); + $request->_set_route($route); + + # Add session to app *if* we have a session and the request + # has the appropriate cookie header for _this_ app. + if ( my $sess = $runner->{'internal_sessions'}{$cname} ) { + $self->set_session($sess); + } + + # calling the actual route + my $response; + + # this is very evil, but allows breaking out of multiple stack + # frames without throwing an exception. Avoiding exceptions means + # a naive eval won't swallow our flow control mechanisms, and + # avoids __DIE__ handlers. It also prevents some cleanup routines + # from working, since they are expecting control to return to them + # after an eval. + DANCER2_CORE_APP_ROUTE_RETURN: { + if (!$self->has_with_return) { + $self->set_with_return(sub { + $response = shift; + no warnings 'exiting'; + last DANCER2_CORE_APP_ROUTE_RETURN; + }); + } + $response = $self->_dispatch_route($route); + }; + + # ensure we clear the with_return handler + $self->clear_with_return; + + # handle forward requests + if ( ref $response eq 'Dancer2::Core::Request' ) { + # this is actually a request, not response + # however, we need to clean up the request & response + $self->clear_request; + $self->clear_response; + + # this is in case we're asked for an old-style dispatching + if ( $runner->{'internal_dispatch'} ) { + # Get the session object from the app before we clean up + # the request context, so we can propagate this to the + # next dispatch cycle (if required). + $self->_has_session + and $runner->{'internal_sessions'}{$cname} = + $self->session; + + $runner->{'internal_forward'} = 1; + $runner->{'internal_request'} = $response; + return $self->response_not_found($request); + } + + $request = $response; + next DISPATCH; + } + + # from here we assume the response is a Dancer2::Core::Response + + # halted response, don't process further + if ( $response->is_halted ) { + $self->cleanup; + delete $runner->{'internal_request'}; + return $response; + } + + # pass the baton if the response says so... + if ( $response->has_passed ) { + ## A previous route might have used splat, failed + ## this needs to be cleaned from the request. + exists $request->{_params}{splat} + and delete $request->{_params}{splat}; + + $response->has_passed(0); # clear for the next round + + # clear the content because if you pass it, + # the next route is in charge of catching it + $response->clear_content; + next ROUTE; + } + + # it's just a regular response + $self->execute_hook( 'core.app.after_request', $response ); + $self->cleanup; + delete $runner->{'internal_request'}; + + return $response; + } + + # we don't actually want to continue the loop + last; + } + + # No response! ensure Core::Dispatcher recognizes this failure + # so it can try the next Core::App + # and set the created request so we don't create it again + # (this is important so we don't ignore the previous body) + if ( $runner->{'internal_dispatch'} ) { + $runner->{'internal_404'} = 1; + $runner->{'internal_request'} = $request; + } + + # Render 404 response, cleanup, and return the response. + my $response = $self->response_not_found($request); + $self->cleanup; + return $response; +} + +sub build_request { + my ( $self, $env ) = @_; + + # If we have an app, send the serialization engine + my $request = Dancer2::Core::Request->new( + env => $env, + is_behind_proxy => $self->settings->{'behind_proxy'} || 0, + + $self->has_serializer_engine + ? ( serializer => $self->serializer_engine ) + : (), + ); + + return $request; +} + +# Call any before hooks then the matched route. +sub _dispatch_route { + my ( $self, $route ) = @_; + + local $@; + eval { + $EVAL_SHIM->(sub { + $self->execute_hook( 'core.app.before_request', $self ); + }); + 1; + } or do { + my $err = $@ || "Zombie Error"; + return $self->response_internal_error($err); + }; + my $response = $self->response; + + if ( $response->is_halted ) { + return $self->_prep_response( $response ); + } + + eval { + $EVAL_SHIM->(sub{ $response = $route->execute($self) }); + 1; + } or do { + my $err = $@ || "Zombie Error"; + return $self->response_internal_error($err); + }; + + return $response; +} + +sub _prep_response { + my ( $self, $response, $content ) = @_; + + # The response object has no back references to the content or app + # Update the default_content_type of the response if any value set in + # config so it can be applied when the response is encoded/returned. + my $config = $self->config; + if ( exists $config->{content_type} + and my $ct = $config->{content_type} ) { + $response->default_content_type($ct); + } + + # if we were passed any content, set it in the response + defined $content && $response->content($content); + return $response; +} + +sub response_internal_error { + my ( $self, $error ) = @_; + + $self->execute_hook( 'core.app.route_exception', $self, $error ); + $self->log( error => "Route exception: $error" ); + + local $Dancer2::Core::Route::REQUEST = $self->request; + local $Dancer2::Core::Route::RESPONSE = $self->response; + + return Dancer2::Core::Error->new( + app => $self, + status => 500, + exception => $error, + )->throw; +} + +sub response_not_found { + my ( $self, $request ) = @_; + + $self->set_request($request); + + local $Dancer2::Core::Route::REQUEST = $self->request; + local $Dancer2::Core::Route::RESPONSE = $self->response; + + my $response = Dancer2::Core::Error->new( + app => $self, + status => 404, + message => $request->path, + )->throw; + + $self->cleanup; + + return $response; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::App - encapsulation of Dancer2 packages + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Everything a package that uses Dancer2 does is encapsulated into a +C<Dancer2::Core::App> instance. This class defines all that can be done in such +objects. + +Mainly, it will contain all the route handlers, the configuration settings and +the hooks that are defined in the calling package. + +Note that with Dancer2, everything that is done within a package is scoped to +that package, thanks to that encapsulation. + +=head1 ATTRIBUTES + +=head2 plugins + +=head2 runner_config + +=head2 default_config + +=head2 with_return + +Used to cache the coderef that will return from back to the dispatcher, across +an arbitrary number of stack frames. + +=head2 destroyed_session + +We cache a destroyed session here; once this is set we must not attempt to +retrieve the session from the cookie in the request. If no new session is +created, this is set (with expiration) as a cookie to force the browser to +expire the cookie. + +=head1 METHODS + +=head2 has_session + +Returns true if session engine has been defined and if either a session +object has been instantiated or if a session cookie was found and not +subsequently invalidated. + +=head2 change_session_id + +Changes the session ID used by the current session. This should be used on +any change of privilege level, for example on login. Returns the new session +ID. + +=head2 destroy_session + +Destroys the current session and ensures any subsequent session is created +from scratch and not from the request session cookie + +=head2 register_plugin + +=head2 with_plugins( @plugin_names ) + +Creates instances of the given plugins and tie them to the app. +The plugin classes are automatically loaded. +Returns the newly created plugins. + +The plugin names are expected to be without the leading C<Dancer2::Plugin>. +I.e., use C<Foo> to mean C<Dancer2::Plugin::Foo>. + +If a given plugin is already tied to the app, the already-existing +instance will be used and returned by C<with_plugins> (think of it +as using a role). + + my @plugins = $app->with_plugins( 'Foo', 'Bar' ); + + # now $app uses the plugins Dancer2::Plugin::Foo + # and Dancer2::Plugin::Bar + +=head2 with_plugin( $plugin_name ) + +Just like C<with_plugin>, but for a single plugin. + + my $plugin = $app->with_plugin('Foo'); + +=head2 add_route + +Register a new route handler. + + $app->add_route( + method => 'get', + regexp => '/somewhere', + code => sub { ... }, + options => $conditions, + ); + +Returns a new L<< Dancer2::Core::Route >> object created with the passed +arguments. + +=head2 route_exists + +Returns a true value if a route already exists, otherwise false. + + my $route = Dancer2::Core::Route->new(...); + if ($app->route_exists($route)) { + ... + } + +=head2 routes_regexps_for + +Sugar for getting the ordered list of all registered route regexps by method. + + my $regexps = $app->routes_regexps_for( 'get' ); + +Returns an ArrayRef with the results. + +=head2 redirect($destination, $status) + +Sets a redirect in the response object. If $destination is not an absolute URI, then it will +be made into an absolute URI, relative to the URI in the request. + +=head2 halt + +Flag the response object as 'halted'. + +If called during request dispatch, immediately returns the response +to the dispatcher and after hooks will not be run. + +=head2 pass + +Flag the response object as 'passed'. + +If called during request dispatch, immediately returns the response +to the dispatcher. + +=head2 forward + +Create a new request which is a clone of the current one, apart +from the path location, which points instead to the new location. +This is used internally to chain requests using the forward keyword. + +This method takes 3 parameters: the url to forward to, followed by an +optional hashref of parameters added to the current request parameters, +followed by a hashref of options regarding the redirect, such as +C<method> to change the request method. + +For example: + + forward '/login', { login_failed => 1 }, { method => 'GET' }); + +=head2 app + +Returns itself. This is simply available as a shim to help transition from +a previous version in which hooks were sent a context object (originally +C<Dancer2::Core::Context>) which has since been removed. + + # before + hook before => sub { + my $ctx = shift; + my $app = $ctx->app; + }; + + # after + hook before => sub { + my $app = shift; + }; + +This meant that C<< $app->app >> would fail, so this method has been provided +to make it work. + + # now + hook before => sub { + my $WannaBeCtx = shift; + my $app = $WannaBeContext->app; # works + }; + +=head2 lexical_prefix + +Allow for setting a lexical prefix + + $app->lexical_prefix('/blog', sub { + ... + }); + +All the route defined within the callback will have a prefix appended to the +current one. + +=head2 C< $SIG{__DIE__} > Compatibility via C< $Dancer2::Core::App::EVAL_SHIM > + +If an installation wishes to use C< $SIG{__DIE__} > hooks to enhance +their error handling then it may be required to ensure that certain +bookkeeping code is executed within every C<eval BLOCK> that Dancer2 +performs. This can be accomplished by overriding the global variable +C<$Dancer2::Core::App::EVAL_SHIM> with a subroutine which does whatever +logic is required. + +This routine must perform the equivalent of the following subroutine: + + our $EVAL_SHIM = sub { + my $code = shift; + return $code->(@_); + }; + +An example of overriding this sub might be as follows: + + $Dancer2::Core::App::EVAL_SHIM = sub { + my $code = shift; + local $IGNORE_EVAL_COUNTER = $IGNORE_EVAL_COUNTER + 1; + return $code->(@_); + }; + +B<Note:> that this is a GLOBAL setting, which must be set up before +any form of dispatch or use of Dancer2. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Cookie.pm b/lib/Dancer2/Core/Cookie.pm new file mode 100644 index 00000000..f57dabe2 --- /dev/null +++ b/lib/Dancer2/Core/Cookie.pm @@ -0,0 +1,250 @@ +package Dancer2::Core::Cookie; +# ABSTRACT: A cookie representing class +$Dancer2::Core::Cookie::VERSION = '0.300000'; +use Moo; +use URI::Escape; +use Dancer2::Core::Types; +use Dancer2::Core::Time; +use Carp 'croak'; +use Ref::Util qw< is_arrayref is_hashref >; +use overload '""' => \&_get_value; + +BEGIN { + my $try_xs = + exists($ENV{PERL_HTTP_XSCOOKIES}) ? !!$ENV{PERL_HTTP_XSCOOKIES} : + exists($ENV{PERL_ONLY}) ? !$ENV{PERL_ONLY} : + 1; + + my $use_xs = 0; + $try_xs and eval { + require HTTP::XSCookies; + $use_xs++; + }; + if ( $use_xs ) { + *to_header = \&xs_to_header; + } + else { + *to_header = \&pp_to_header; + } + *_USE_XS = $use_xs ? sub () { !!1 } : sub () { !!0 }; +} + +sub xs_to_header { + my $self = shift; + + # HTTP::XSCookies can't handle multi-value cookies. + return $self->pp_to_header(@_) if @{[ $self->value ]} > 1; + + return HTTP::XSCookies::bake_cookie( + $self->name, + { value => $self->value, + path => $self->path, + domain => $self->domain, + expires => $self->expires, + httponly => !!$self->http_only, # HTTP::XSCookies seems to distinguish between '"0"' and '0' + secure => $self->secure, + samesite => $self->same_site, + } + ); +} + +sub pp_to_header { + my $self = shift; + + my $value = join( '&', map uri_escape($_), $self->value ); + my $no_httponly = defined( $self->http_only ) && $self->http_only == 0; + + my @headers = $self->name . '=' . $value; + push @headers, "Path=" . $self->path if $self->path; + push @headers, "Expires=" . $self->expires if $self->expires; + push @headers, "Domain=" . $self->domain if $self->domain; + push @headers, "SameSite=" . $self->same_site if $self->same_site; + push @headers, "Secure" if $self->secure; + push @headers, 'HttpOnly' unless $no_httponly; + + return join '; ', @headers; +} + +has value => ( + is => 'rw', + isa => ArrayRef, + required => 0, + coerce => sub { + my $value = shift; + my @values = + is_arrayref($value) ? @$value + : is_hashref($value) ? %$value + : ($value); + return [@values]; + }, +); + +around value => sub { + my $orig = shift; + my $self = shift; + my $array = $orig->( $self, @_ ); + return wantarray ? @$array : $array->[0]; +}; + +# this is only for overloading; need a real sub to refer to, as the Moose +# attribute accessor won't be available at that point. +sub _get_value { shift->value } + +has name => ( + is => 'rw', + isa => Str, + required => 1, +); + +has expires => ( + is => 'rw', + isa => Str, + required => 0, + coerce => sub { + Dancer2::Core::Time->new( expression => $_[0] )->gmt_string; + }, +); + +has domain => ( + is => 'rw', + isa => Str, + required => 0, +); + +has path => ( + is => 'rw', + isa => Str, + default => sub {'/'}, + predicate => 1, +); + +has secure => ( + is => 'rw', + isa => Bool, + required => 0, + default => sub {0}, +); + +has http_only => ( + is => 'rw', + isa => Bool, + required => 0, + default => sub {1}, +); + +has same_site => ( + is => 'rw', + isa => Enum[qw[Strict Lax]], + required => 0, +); + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Cookie - A cookie representing class + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + use Dancer2::Core::Cookie; + + my $cookie = Dancer2::Core::Cookie->new( + name => $cookie_name, value => $cookie_value + ); + + my $value = $cookie->value; + + print "$cookie"; # objects stringify to their value. + +=head1 DESCRIPTION + +Dancer2::Core::Cookie provides a HTTP cookie object to work with cookies. + +=head1 ATTRIBUTES + +=head2 value + +The cookie's value. + +(Note that cookie objects use overloading to stringify to their value, so if +you say e.g. return "Hi, $cookie", you'll get the cookie's value there.) + +In list context, returns a list of potentially multiple values; in scalar +context, returns just the first value. (So, if you expect a cookie to have +multiple values, use list context.) + +=head2 name + +The cookie's name. + +=head2 expires + +The cookie's expiration date. There are several formats. + +Unix epoch time like 1288817656 to mean "Wed, 03-Nov-2010 20:54:16 GMT" + +It also supports a human readable offset from the current time such as "2 hours". +See the documentation of L<Dancer2::Core::Time> for details of all supported +formats. + +=head2 domain + +The cookie's domain. + +=head2 path + +The cookie's path. + +=head2 secure + +If true, it instructs the client to only serve the cookie over secure +connections such as https. + +=head2 http_only + +By default, cookies are created with a property, named C<HttpOnly>, +that can be used for security, forcing the cookie to be used only by +the server (via HTTP) and not by any JavaScript code. + +If your cookie is meant to be used by some JavaScript code, set this +attribute to 0. + +=head2 same_site + +Whether the cookie ought not to be sent along with cross-site requests, +an enum of either "Strict" or "Lax", default is unset. + +=head1 METHODS + +=head2 my $cookie=Dancer2::Core::Cookie->new(%opts); + +Create a new Dancer2::Core::Cookie object. + +You can set any attribute described in the I<ATTRIBUTES> section above. + +=head2 my $header=$cookie->to_header(); + +Creates a proper HTTP cookie header from the content. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/DSL.pm b/lib/Dancer2/Core/DSL.pm new file mode 100644 index 00000000..8c3a719f --- /dev/null +++ b/lib/Dancer2/Core/DSL.pm @@ -0,0 +1,558 @@ +# ABSTRACT: Dancer2's Domain Specific Language (DSL) + +package Dancer2::Core::DSL; +$Dancer2::Core::DSL::VERSION = '0.300000'; +use Moo; +use Carp; +use Module::Runtime 'require_module'; +use Ref::Util qw< is_arrayref >; +use Dancer2::Core::Hook; +use Dancer2::FileUtils; +use Dancer2::Core::Response::Delayed; + +with 'Dancer2::Core::Role::DSL'; + +sub hook_aliases { +{} } +sub supported_hooks { () } + +sub _add_postponed_plugin_hooks { + my ( $self, $postponed_hooks) = @_; + + $postponed_hooks = $postponed_hooks->{'plugin'}; + return unless defined $postponed_hooks; + + for my $plugin ( keys %{$postponed_hooks} ) { + for my $name ( keys %{$postponed_hooks->{$plugin} } ) { + my $hook = $postponed_hooks->{$plugin}{$name}{hook}; + my $caller = $postponed_hooks->{$plugin}{$name}{caller}; + + $self->has_hook($name) + or croak "plugin $plugin does not support the hook `$name'. (" + . join( ", ", @{$caller} ) . ")"; + + $self->add_hook($hook); + } + } +} + +sub dsl_keywords { + + # the flag means : 1 = is global, 0 = is not global. global means can be + # called from anywhere. not global means must be called from within a route + # handler + { any => { is_global => 1 }, + app => { is_global => 1 }, + captures => { is_global => 0 }, + config => { is_global => 1 }, + content => { is_global => 0 }, + content_type => { is_global => 0 }, + context => { is_global => 0 }, + cookie => { is_global => 0 }, + cookies => { is_global => 0 }, + dance => { is_global => 1 }, + dancer_app => { is_global => 1 }, + dancer_version => { is_global => 1 }, + dancer_major_version => { is_global => 1 }, + debug => { is_global => 1 }, + decode_json => { is_global => 1 }, + del => { is_global => 1 }, + delayed => { + is_global => 0, prototype => '&@', + }, + dirname => { is_global => 1 }, + done => { is_global => 0 }, + dsl => { is_global => 1 }, + encode_json => { is_global => 1 }, + engine => { is_global => 1 }, + error => { is_global => 1 }, + false => { is_global => 1 }, + flush => { is_global => 0 }, + forward => { is_global => 0 }, + from_dumper => { is_global => 1 }, + from_json => { is_global => 1 }, + from_yaml => { is_global => 1 }, + get => { is_global => 1 }, + halt => { is_global => 0 }, + header => { is_global => 0 }, + headers => { is_global => 0 }, + hook => { is_global => 1 }, + info => { is_global => 1 }, + log => { is_global => 1 }, + mime => { is_global => 1 }, + options => { is_global => 1 }, + param => { is_global => 0 }, + params => { is_global => 0 }, + query_parameters => { is_global => 0 }, + body_parameters => { is_global => 0 }, + route_parameters => { is_global => 0 }, + pass => { is_global => 0 }, + patch => { is_global => 1 }, + path => { is_global => 1 }, + post => { is_global => 1 }, + prefix => { is_global => 1 }, + prepare_app => { + is_global => 1, prototype => '&', + }, + psgi_app => { is_global => 1 }, + push_header => { is_global => 0 }, + push_response_header => { is_global => 0 }, + put => { is_global => 1 }, + redirect => { is_global => 0 }, + request => { is_global => 0 }, + request_header => { is_global => 0 }, + response => { is_global => 0 }, + response_header => { is_global => 0 }, + response_headers => { is_global => 0 }, + runner => { is_global => 1 }, + send_as => { is_global => 0 }, + send_error => { is_global => 0 }, + send_file => { is_global => 0 }, + session => { is_global => 0 }, + set => { is_global => 1 }, + setting => { is_global => 1 }, + splat => { is_global => 0 }, + start => { is_global => 1 }, + status => { is_global => 0 }, + template => { is_global => 1 }, + to_app => { is_global => 1 }, + to_dumper => { is_global => 1 }, + to_json => { is_global => 1 }, + to_yaml => { is_global => 1 }, + true => { is_global => 1 }, + upload => { is_global => 0 }, + uri_for => { is_global => 0 }, + var => { is_global => 0 }, + vars => { is_global => 0 }, + warning => { is_global => 1 }, + }; +} + +sub dancer_app { shift->app } +sub dancer_version { Dancer2->VERSION } + +sub dancer_major_version { + return ( split /\./, dancer_version )[0]; +} + +sub log { shift->app->log( @_ ) } +sub debug { shift->app->log( debug => @_ ) } +sub info { shift->app->log( info => @_ ) } +sub warning { shift->app->log( warning => @_ ) } +sub error { shift->app->log( error => @_ ) } + +sub true {1} +sub false {0} + +sub dirname { shift and Dancer2::FileUtils::dirname(@_) } +sub path { shift and Dancer2::FileUtils::path(@_) } + +sub config { shift->app->settings } + +sub engine { shift->app->engine(@_) } + +sub setting { shift->app->setting(@_) } + +sub set { shift->setting(@_) } + +sub template { shift->app->template(@_) } + +sub session { + my ( $self, $key, $value ) = @_; + + # shortcut reads if no session exists, so we don't + # instantiate sessions for no reason + if ( @_ == 2 ) { + return unless $self->app->has_session; + } + + my $session = $self->app->session + || croak "No session available, a session engine needs to be set"; + + $self->app->setup_session; + + # return the session object if no key + @_ == 1 and return $session; + + # read if a key is provided + @_ == 2 and return $session->read($key); + + + # write to the session or delete if value is undef + if ( defined $value ) { + $session->write( $key => $value ); + } + else { + $session->delete($key); + } +} + +sub send_as { shift->app->send_as(@_) } + +sub send_error { shift->app->send_error(@_) } + +sub send_file { shift->app->send_file(@_) } + +# +# route handlers & friends +# + +sub hook { + my ( $self, $name, $code ) = @_; + $self->app->add_hook( + Dancer2::Core::Hook->new( name => $name, code => $code ) ); +} + +sub prefix { + my $app = shift->app; + @_ == 1 + ? $app->prefix(@_) + : $app->lexical_prefix(@_); +} + +sub halt { shift->app->halt(@_) } + +sub del { shift->_normalize_route( [qw/delete /], @_ ) } +sub get { shift->_normalize_route( [qw/get head/], @_ ) } +sub options { shift->_normalize_route( [qw/options /], @_ ) } +sub patch { shift->_normalize_route( [qw/patch /], @_ ) } +sub post { shift->_normalize_route( [qw/post /], @_ ) } +sub put { shift->_normalize_route( [qw/put /], @_ ) } + +sub prepare_app { push @{ shift->app->prep_apps }, @_ } + +sub any { + my $self = shift; + + # If they've supplied their own list of methods, + # expand del, otherwise give them the default list. + if ( is_arrayref($_[0]) ) { + s/^del$/delete/ for @{ $_[0] }; + } + else { + unshift @_, [qw/delete get head options patch post put/]; + } + + $self->_normalize_route(@_); +} + +sub _normalize_route { + my $app = shift->app; + my $methods = shift; + my %args; + + # Options are optional, deduce their presence from arg length. + # @_ = ( REGEXP, OPTIONS, CODE ) + # or + # @_ = ( REGEXP, CODE ) + @args{qw/regexp options code/} = @_ == 3 ? @_ : ( $_[0], {}, $_[1] ); + + return map $app->add_route( %args, method => $_ ), @{$methods}; +} + +# +# Server startup +# + +# access to the runner singleton +# will be populated on-the-fly when needed +# this singleton contains anything needed to start the application server +sub runner { Dancer2->runner } + +# start the server +sub start { shift->runner->start } + +sub dance { shift->start(@_) } + +sub psgi_app { + my $self = shift; + + $self->app->to_app; +} + +sub to_app { shift->app->to_app } + +# +# Response alterations +# + +sub status { + $Dancer2::Core::Route::RESPONSE->status( $_[1] ); +} + +sub push_header { + # TODO: deprecate old keyword after we have a period of stability + # carp "DEPRECATED: please use the 'push_response_header' keyword instead of 'push_header'"; + goto &push_response_header; +} + +sub push_response_header { + shift; + $Dancer2::Core::Route::RESPONSE->push_header(@_); +} + +sub header { + # TODO: deprecate keyword after a period of stability + # carp "DEPRECATED: please use the 'response_header' keyword instead of 'header'"; + goto &response_header; +} + +sub response_header { + shift; + $Dancer2::Core::Route::RESPONSE->header(@_); +} + +sub headers { + # TODO: deprecate keyword after a period of stability + # carp "DEPRECATED: please use the 'response_headers' keyword instead of 'headers'"; + goto &response_headers; +} + +sub response_headers { + shift; + $Dancer2::Core::Route::RESPONSE->header(@_); +} + +sub content { + my $dsl = shift; + + # simple synchronous response + my $responder = $Dancer2::Core::Route::RESPONDER + or croak 'Cannot use content keyword outside delayed response'; + + # flush if wasn't flushed before + if ( !$Dancer2::Core::Route::WRITER ) { + $Dancer2::Core::Route::WRITER = $responder->([ + $Dancer2::Core::Route::RESPONSE->status, + $Dancer2::Core::Route::RESPONSE->headers_to_array, + ]); + } + + eval { + $Dancer2::Core::Route::WRITER->write(@_); + 1; + } or do { + my $error = $@ || 'Zombie Error'; + $Dancer2::Core::Route::ERROR_HANDLER + ? $Dancer2::Core::Route::ERROR_HANDLER->($error) + : $dsl->app->logger_engine->log( + warning => "Error in delayed response: $error" + ); + }; +} + +sub content_type { + shift; + $Dancer2::Core::Route::RESPONSE->content_type(@_); +} + +sub delayed { + my ( $dsl, $cb, @args ) = @_; + + @args % 2 == 0 + or croak 'Arguments to delayed() keyword must be key/value pairs'; + + # first time, responder doesn't exist yet + my %opts = @args; + $Dancer2::Core::Route::RESPONDER + or return Dancer2::Core::Response::Delayed->new( + cb => $cb, + request => $Dancer2::Core::Route::REQUEST, + response => $Dancer2::Core::Route::RESPONSE, + + ( error_cb => $opts{'on_error'} )x!! $opts{'on_error'}, + ); + + # we're in an async request process + my $request = $Dancer2::Core::Route::REQUEST; + my $response = $Dancer2::Core::Route::RESPONSE; + my $responder = $Dancer2::Core::Route::RESPONDER; + my $writer = $Dancer2::Core::Route::WRITER; + my $handler = $Dancer2::Core::Route::ERROR_HANDLER; + + return sub { + local $Dancer2::Core::Route::REQUEST = $request; + local $Dancer2::Core::Route::RESPONSE = $response; + local $Dancer2::Core::Route::RESPONDER = $responder; + local $Dancer2::Core::Route::WRITER = $writer; + local $Dancer2::Core::Route::ERROR_HANDLER = $handler; + + $cb->(@_); + }; +} + +sub flush { + my $responder = $Dancer2::Core::Route::RESPONDER + or croak 'flush() called outside streaming response'; + + my $response = $Dancer2::Core::Route::RESPONSE; + $Dancer2::Core::Route::WRITER = $responder->([ + $response->status, $response->headers_to_array, + ]); +} + +sub done { + my $writer = $Dancer2::Core::Route::WRITER + or croak 'done() called outside streaming response'; + + $writer->close; +} + +sub pass { shift->app->pass } + +# +# Route handler helpers +# + +sub context { + carp "DEPRECATED: please use the 'app' keyword instead of 'context'"; + shift->app; +} + +sub request { $Dancer2::Core::Route::REQUEST } + +sub request_header { shift; $Dancer2::Core::Route::REQUEST->headers->header(@_) } + +sub response { $Dancer2::Core::Route::RESPONSE } + +sub upload { shift; $Dancer2::Core::Route::REQUEST->upload(@_); } + +sub captures { $Dancer2::Core::Route::REQUEST->captures } + +sub uri_for { shift; $Dancer2::Core::Route::REQUEST->uri_for(@_); } + +sub splat { $Dancer2::Core::Route::REQUEST->splat } + +sub params { shift; $Dancer2::Core::Route::REQUEST->params(@_); } + +sub param { shift; $Dancer2::Core::Route::REQUEST->param(@_); } + +sub query_parameters { shift; $Dancer2::Core::Route::REQUEST->query_parameters(@_); } +sub body_parameters { shift; $Dancer2::Core::Route::REQUEST->body_parameters(@_); } +sub route_parameters { shift; $Dancer2::Core::Route::REQUEST->route_parameters(@_); } + +sub redirect { shift->app->redirect(@_) } + +sub forward { shift->app->forward(@_) } + +sub vars { $Dancer2::Core::Route::REQUEST->vars } + +sub var { shift; $Dancer2::Core::Route::REQUEST->var(@_); } + +sub cookies { $Dancer2::Core::Route::REQUEST->cookies } +sub cookie { shift->app->cookie(@_) } + +sub mime { + my $self = shift; + if ( $self->app ) { + return $self->app->mime_type; + } + else { + my $runner = $self->runner; + $runner->mime_type->reset_default; + return $runner->mime_type; + } +} + +# +# engines +# + +sub from_json { + shift; # remove first element + require_module('Dancer2::Serializer::JSON'); + Dancer2::Serializer::JSON::from_json(@_); +} + +sub to_json { + shift; # remove first element + require_module('Dancer2::Serializer::JSON'); + Dancer2::Serializer::JSON::to_json(@_); +} + +sub decode_json { + shift; # remove first element + require_module('Dancer2::Serializer::JSON'); + Dancer2::Serializer::JSON::decode_json(@_); +} + +sub encode_json { + shift; # remove first element + require_module('Dancer2::Serializer::JSON'); + Dancer2::Serializer::JSON::encode_json(@_); +} + +sub from_yaml { + shift; # remove first element + require_module('Dancer2::Serializer::YAML'); + Dancer2::Serializer::YAML::from_yaml(@_); +} + +sub to_yaml { + shift; # remove first element + require_module('Dancer2::Serializer::YAML'); + Dancer2::Serializer::YAML::to_yaml(@_); +} + +sub from_dumper { + shift; # remove first element + require_module('Dancer2::Serializer::Dumper'); + Dancer2::Serializer::Dumper::from_dumper(@_); +} + +sub to_dumper { + shift; # remove first element + require_module('Dancer2::Serializer::Dumper'); + Dancer2::Serializer::Dumper::to_dumper(@_); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::DSL - Dancer2's Domain Specific Language (DSL) + +=head1 VERSION + +version 0.300000 + +=head1 FUNCTIONS + +=head2 setting + +Lets you define settings and access them: + + setting('foo' => 42); + setting('foo' => 42, 'bar' => 43); + my $foo=setting('foo'); + +If settings were defined returns number of settings. + +=head2 set () + +alias for L<setting>: + + set('foo' => '42'); + my $port=set('port'); + +=head1 SEE ALSO + +L<http://advent.perldancer.org/2010/18> + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Dispatcher.pm b/lib/Dancer2/Core/Dispatcher.pm new file mode 100644 index 00000000..b4db7023 --- /dev/null +++ b/lib/Dancer2/Core/Dispatcher.pm @@ -0,0 +1,141 @@ +package Dancer2::Core::Dispatcher; +# ABSTRACT: Class for dispatching request to the appropriate route handler +$Dancer2::Core::Dispatcher::VERSION = '0.300000'; +use Moo; + +use Dancer2::Core::Types; +use Dancer2::Core::Request; +use Dancer2::Core::Response; + +has apps => ( + is => 'rw', + isa => ArrayRef, + default => sub { [] }, +); + +has apps_psgi => ( + is => 'ro', + isa => ArrayRef, + lazy => 1, + builder => '_build_apps_psgi', +); + +sub _build_apps_psgi { + my $self = shift; + return [ map +( $_->name, $_->to_app ), @{ $self->apps } ]; +} + +sub dispatch { + my ( $self, $env ) = @_; + my @apps = @{ $self->apps_psgi }; + + DISPATCH: while (1) { + for ( my $i = 0; $i < @apps; $i += 2 ) { + my ( $app_name, $app ) = @apps[ $i, $i + 1 ]; + + my $response = $app->($env); + + # check for an internal request + delete Dancer2->runner->{'internal_forward'} + and next DISPATCH; + + # the app raised a flag saying it couldn't match anything + # which is different than "I matched and it's a 404" + delete Dancer2->runner->{'internal_404'} + or do { + delete Dancer2->runner->{'internal_request'}; + return $response; + }; + } + + # don't run anymore + delete Dancer2->runner->{'internal_request'}; + last; + } # while + + # a 404 on all apps, using the first app + my $default_app = $self->apps->[0]; + my $request = $default_app->build_request($env); + return $default_app->response_not_found($request)->to_psgi; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Dispatcher - Class for dispatching request to the appropriate route handler + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + use Dancer2::Core::Dispatcher; + + # Create an instance of dispatcher + my $dispatcher = Dancer2::Core::Dispatcher->new( apps => [$app] ); + + # Dispatch a request + my $resp = $dispatcher->dispatch($env)->to_psgi; + + # Capture internal error of a response (if any) after a dispatch + $dispatcher->response_internal_error($app, $error); + + # Capture response not found for an application the after dispatch + $dispatcher->response_not_found($env); + +=head1 ATTRIBUTES + +=head2 apps + +The apps is an array reference to L<Dancer2::Core::App>. + +=head2 default_content_type + +The default_content_type is a string which represents the context of the +request. This attribute is read-only. + +=head1 METHODS + +=head2 dispatch + +The C<dispatch> method accepts the list of applications, hash reference for +the B<env> attribute of L<Dancer2::Core::Request> and optionally the request +object and an env as input arguments. + +C<dispatch> returns a response object of L<Dancer2::Core::Response>. + +Any before hook and matched route code is wrapped to allow DSL keywords such +as forward and redirect to short-circuit remaining code, returning across +multiple stack frames without having to throw an exception. + +=head2 response_internal_error + +The C<response_internal_error> takes as input the list of applications and +a variable error and returns an object of L<Dancer2::Core::Error>. + +=head2 response_not_found + +The C<response_not_found> consumes as input the list of applications and an +object of type L<Dancer2::Core::App> and returns an object +L<Dancer2::Core::Error>. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Error.pm b/lib/Dancer2/Core/Error.pm new file mode 100644 index 00000000..7d9f667d --- /dev/null +++ b/lib/Dancer2/Core/Error.pm @@ -0,0 +1,596 @@ +package Dancer2::Core::Error; +# ABSTRACT: Class representing fatal errors +$Dancer2::Core::Error::VERSION = '0.300000'; +use Moo; +use Carp; +use Dancer2::Core::Types; +use Dancer2::Core::HTTP; +use Data::Dumper; +use Dancer2::FileUtils qw/path open_file/; +use Sub::Quote; +use Module::Runtime 'require_module'; +use Ref::Util qw< is_hashref >; +use Clone qw(clone); + +has app => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::App'], + predicate => 'has_app', +); + +has show_errors => ( + is => 'ro', + isa => Bool, + default => sub { + my $self = shift; + + $self->has_app + and return $self->app->setting('show_errors'); + }, +); + +has charset => ( + is => 'ro', + isa => Str, + default => sub {'UTF-8'}, +); + +has type => ( + is => 'ro', + isa => Str, + default => sub {'Runtime Error'}, +); + +has title => ( + is => 'ro', + isa => Str, + lazy => 1, + builder => '_build_title', +); + +sub _build_title { + my ($self) = @_; + my $title = 'Error ' . $self->status; + if ( my $msg = Dancer2::Core::HTTP->status_message($self->status) ) { + $title .= ' - ' . $msg; + } + + return $title; +} + +has template => ( + is => 'ro', + lazy => 1, + builder => '_build_error_template', +); + +sub _build_error_template { + my ($self) = @_; + + # look for a template named after the status number. + # E.g.: views/404.tt for a TT template + my $engine = $self->app->template_engine; + return $self->status + if $engine->pathname_exists( $engine->view_pathname( $self->status ) ); + + return; +} + +has static_page => ( + is => 'ro', + lazy => 1, + builder => '_build_static_page', +); + +sub _build_static_page { + my ($self) = @_; + + # TODO there must be a better way to get it + my $public_dir = $ENV{DANCER_PUBLIC} + || ( $self->has_app && $self->app->config->{public_dir} ); + + my $filename = sprintf "%s/%d.html", $public_dir, $self->status; + + open my $fh, '<', $filename or return; + + local $/ = undef; # slurp time + + return <$fh>; +} + +sub default_error_page { + my $self = shift; + + require_module('Template::Tiny'); + + my $uri_base = $self->has_app && $self->app->has_request ? + $self->app->request->uri_base : ''; + + # GH#1001 stack trace if show_errors is true and this is a 'server' error (5xx) + my $show_fullmsg = $self->show_errors && $self->status =~ /^5/; + my $opts = { + title => $self->title, + charset => $self->charset, + content => $show_fullmsg ? $self->full_message : _html_encode($self->message) || 'Wooops, something went wrong', + version => Dancer2->VERSION, + uri_base => $uri_base, + }; + + Template::Tiny->new->process( \<<"END_TEMPLATE", $opts, \my $output ); +<!DOCTYPE html> +<html lang="en"> +<head> + <meta charset="[% charset %]"> + <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes"> + <title>[% title %]</title> + <link rel="stylesheet" href="[% uri_base %]/css/error.css"> +</head> +<body> +<h1>[% title %]</h1> +<div id="content"> +[% content %] +</div> +<div id="footer"> +Powered by <a href="http://perldancer.org/">Dancer2</a> [% version %] +</div> +</body> +</html> +END_TEMPLATE + + return $output; +} + +has status => ( + is => 'ro', + default => sub {500}, + isa => Num, +); + +has message => ( + is => 'ro', + isa => Str, + lazy => 1, + default => sub { '' }, +); + +sub full_message { + my ($self) = @_; + my $html_output = "<h2>" . $self->type . "</h2>"; + $html_output .= $self->backtrace; + $html_output .= $self->environment; + return $html_output; +} + +has serializer => ( + is => 'ro', + isa => Maybe[ConsumerOf['Dancer2::Core::Role::Serializer']], + builder => '_build_serializer', +); + +sub _build_serializer { + my ($self) = @_; + + $self->has_app && $self->app->has_serializer_engine + and return $self->app->serializer_engine; + + return; +} + +sub BUILD { + my ($self) = @_; + + $self->has_app && + $self->app->execute_hook( 'core.error.init', $self ); +} + +has exception => ( + is => 'ro', + isa => Str, + predicate => 1, + coerce => sub { + # Until we properly support exception objects, we shouldn't barf on + # them because that hides the actual error, if object overloads "", + # which most exception objects do, this will result in a nicer string. + # other references will produce a meaningless error, but that is + # better than a meaningless stacktrace + return "$_[0]" + } +); + +has response => ( + is => 'rw', + lazy => 1, + default => sub { + my $self = shift; + my $serializer = $self->serializer; + # include server tokens in response ? + my $no_server_tokens = $self->has_app + ? $self->app->config->{'no_server_tokens'} + : defined $ENV{DANCER_NO_SERVER_TOKENS} + ? $ENV{DANCER_NO_SERVER_TOKENS} + : 0; + return Dancer2::Core::Response->new( + server_tokens => !$no_server_tokens, + ( serializer => $serializer )x!! $serializer + ); + } +); + +has content_type => ( + is => 'ro', + lazy => 1, + default => sub { + my $self = shift; + $self->serializer + ? $self->serializer->content_type + : 'text/html' + }, +); + +has content => ( + is => 'ro', + lazy => 1, + builder => '_build_content', +); + +sub _build_content { + my $self = shift; + + # return a hashref if a serializer is available + if ( $self->serializer ) { + my $content = { + message => $self->message, + title => $self->title, + status => $self->status, + }; + $content->{exception} = $self->exception + if $self->has_exception; + return $content; + } + + # otherwise we check for a template, for a static file, + # for configured error_template, and, if all else fails, + # the default error page + if ( $self->has_app and $self->template ) { + # Render the template using apps' template engine. + # This may well be what caused the initial error, in which + # case we fall back to static page if any error was thrown. + # Note: this calls before/after render hooks. + my $content = eval { + $self->app->template( + $self->template, + { title => $self->title, + content => $self->message, + exception => $self->exception, + status => $self->status, + } + ); + }; + $@ && $self->app->engine('logger')->log( warning => $@ ); + + # return rendered content unless there was an error. + return $content if defined $content; + } + + # It doesn't make sense to return a static page for a 500 if show_errors is on + if ( !($self->show_errors && $self->status eq '500') ) { + if ( my $content = $self->static_page ) { + return $content; + } + } + + if ($self->has_app && $self->app->config->{error_template}) { + my $content = eval { + $self->app->template( + $self->app->config->{error_template}, + { title => $self->title, + content => $self->message, + exception => $self->exception, + status => $self->status, + } + ); + }; + $@ && $self->app->engine('logger')->log( warning => $@ ); + + # return rendered content unless there was an error. + return $content if defined $content; + } + + return $self->default_error_page; +} + +sub throw { + my $self = shift; + $self->response(shift) if @_; + + $self->response + or croak "error has no response to throw at"; + + $self->has_app && + $self->app->execute_hook( 'core.error.before', $self ); + + my $message = $self->content; + + $self->response->status( $self->status ); + $self->response->content_type( $self->content_type ); + $self->response->content($message); + + $self->has_app && + $self->app->execute_hook('core.error.after', $self->response); + + $self->response->is_halted(1); + return $self->response; +} + +sub backtrace { + my ($self) = @_; + + my $message = $self->message; + if ($self->exception) { + $message .= "\n" if $message; + $message .= $self->exception; + } + $message ||= 'Wooops, something went wrong'; + + my $html = '<pre class="error">' . _html_encode($message) . "</pre>\n"; + + # the default perl warning/error pattern + my ($file, $line) = $message =~ /at (\S+) line (\d+)/; + # the Devel::SimpleTrace pattern + ($file, $line) = $message =~ /at.*\((\S+):(\d+)\)/ unless $file and $line; + + # no file/line found, cannot open a file for context + return $html unless $file and $line; + + # file and line are located, let's read the source Luke! + my $fh = eval { open_file('<', $file) } or return $html; + my @lines = <$fh>; + close $fh; + + $html .= qq|<div class="title">$file around line $line</div>|; + + # get 5 lines of context + my $start = $line - 5 > 1 ? $line - 5 : 1; + my $stop = $line + 5 < @lines ? $line + 5 : @lines; + + $html .= qq|<pre class="content"><table class="context">\n|; + for my $l ($start .. $stop) { + chomp $lines[$l - 1]; + + $html .= $l == $line ? '<tr class="errline">' : '<tr>'; + $html .= "<th>$l</th><td>" . _html_encode($lines[$l - 1]) . "</td></tr>\n"; + } + $html .= "</table></pre>\n"; + + return $html; +} + +sub dumper { + my $obj = shift; + + # Take a copy of the data, so we can mask sensitive-looking stuff: + my $data = clone($obj); + my $censored = _censor( $data ); + + #use Data::Dumper; + my $dd = Data::Dumper->new( [ $data ] ); + my $hash_separator = ' @@!%,+$$#._(-- '; # Very unlikely string to exist already + my $prefix_padding = ' #+#+@%.,$_-!(( '; # Very unlikely string to exist already + $dd->Terse(1)->Quotekeys(0)->Indent(1)->Sortkeys(1)->Pair($hash_separator)->Pad($prefix_padding); + my $content = _html_encode( $dd->Dump ); + $content =~ s/^.+//; # Remove the first line + $content =~ s/\n.+$//; # Remove the last line + $content =~ s/^\Q$prefix_padding\E //gm; # Remove the padding + $content =~ s{^(\s*)(.+)\Q$hash_separator}{$1<span class="key">$2</span> => }gm; + if ($censored) { + $content + .= "\n\nNote: Values of $censored sensitive-looking keys hidden\n"; + } + return $content; +} + +sub environment { + my ($self) = @_; + + my $stack = $self->get_caller; + my $settings = $self->has_app && $self->app->settings; + my $session = $self->has_app && $self->app->_has_session && $self->app->session->data; + my $env = $self->has_app && $self->app->has_request && $self->app->request->env; + + # Get a sanitised dump of the settings, session and environment + $_ = $_ ? dumper($_) : '<i>undefined</i>' for $settings, $session, $env; + + return <<"END_HTML"; +<div class="title">Stack</div><pre class="content">$stack</pre> +<div class="title">Settings</div><pre class="content">$settings</pre> +<div class="title">Session</div><pre class="content">$session</pre> +<div class="title">Environment</div><pre class="content">$env</pre> +END_HTML +} + +sub get_caller { + my ($self) = @_; + my @stack; + + my $deepness = 0; + while ( my ( $package, $file, $line ) = caller( $deepness++ ) ) { + push @stack, "$package in $file l. $line"; + } + + return join( "\n", reverse(@stack) ); +} + +# private + +# Given a hashref, censor anything that looks sensitive. Returns number of +# items which were "censored". + +sub _censor { + my $hash = shift; + my $visited = shift || {}; + + unless ( $hash && is_hashref($hash) ) { + carp "_censor given incorrect input: $hash"; + return; + } + + my $censored = 0; + for my $key ( keys %$hash ) { + if ( is_hashref( $hash->{$key} ) ) { + if (!$visited->{ $hash->{$key} }) { + # mark the new ref as visited + $visited->{ $hash->{$key} } = 1; + + $censored += _censor( $hash->{$key}, $visited ); + } + } + elsif ( $key =~ /(pass|card?num|pan|secret)/i ) { + $hash->{$key} = "Hidden (looks potentially sensitive)"; + $censored++; + } + } + + return $censored; +} + +# Replaces the entities that are illegal in (X)HTML. +sub _html_encode { + my $value = shift; + + return if !defined $value; + + $value =~ s/&/&/g; + $value =~ s/</</g; + $value =~ s/>/>/g; + $value =~ s/'/'/g; + $value =~ s/"/"/g; + + return $value; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Error - Class representing fatal errors + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + # taken from send_file: + use Dancer2::Core::Error; + + my $error = Dancer2::Core::Error->new( + status => 404, + message => "No such file: `$path'" + ); + + Dancer2::Core::Response->set($error->render); + +=head1 DESCRIPTION + +With Dancer2::Core::Error you can throw reasonable-looking errors to the user +instead of crashing the application and filling up the logs. + +This is usually used in debugging environments, and it's what Dancer2 uses as +well under debugging to catch errors and show them on screen. + +=head1 ATTRIBUTES + +=head2 show_errors + +=head2 charset + +=head2 type + +The error type. + +=head2 title + +The title of the error page. + +This is only an attribute getter, you'll have to set it at C<new>. + +=head2 status + +The status that caused the error. + +This is only an attribute getter, you'll have to set it at C<new>. + +=head2 message + +The message of the error page. + +=head1 METHODS + +=head2 my $error=new Dancer2::Core::Error(status => 404, message => "No such file: `$path'"); + +Create a new Dancer2::Core::Error object. For available arguments see ATTRIBUTES. + +=head2 supported_hooks (); + +=head2 throw($response) + +Populates the content of the response with the error's information. +If I<$response> is not given, acts on the I<app> +attribute's response. + +=head2 backtrace + +Show the surrounding lines of context at the line where the error was thrown. + +This method tries to find out where the error appeared according to the actual +error message (using the C<message> attribute) and tries to parse it (supporting +the regular/default Perl warning or error pattern and the L<Devel::SimpleTrace> +output) and then returns an error-highlighted C<message>. + +=head2 environment + +A main function to render environment information: the caller (using +C<get_caller>), the settings and environment (using C<dumper>) and more. + +=head2 get_caller + +Creates a stack trace of callers. + +=head1 FUNCTIONS + +=head2 _censor + +An private function that tries to censor out content which should be protected. + +C<dumper> calls this method to censor things like passwords and such. + +=head2 my $string=_html_encode ($string); + +Private function that replaces illegal entities in (X)HTML with their +escaped representations. + +html_encode() doesn't do any UTF black magic. + +=head2 dumper + +This uses L<Data::Dumper> to create nice content output with a few predefined +options. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Factory.pm b/lib/Dancer2/Core/Factory.pm new file mode 100644 index 00000000..02874f00 --- /dev/null +++ b/lib/Dancer2/Core/Factory.pm @@ -0,0 +1,49 @@ +package Dancer2::Core::Factory; +# ABSTRACT: Instantiate components by type and name +$Dancer2::Core::Factory::VERSION = '0.300000'; +use Moo; +use Dancer2::Core; +use Module::Runtime 'use_module'; +use Carp 'croak'; + +sub create { + my ( $class, $type, $name, %options ) = @_; + + $type = Dancer2::Core::camelize($type); + $name = Dancer2::Core::camelize($name); + my $component_class = "Dancer2::${type}::${name}"; + + eval { use_module($component_class); 1; } + or croak "Unable to load class for $type component $name: $@"; + + return $component_class->new(%options); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Factory - Instantiate components by type and name + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/HTTP.pm b/lib/Dancer2/Core/HTTP.pm new file mode 100644 index 00000000..ed055fca --- /dev/null +++ b/lib/Dancer2/Core/HTTP.pm @@ -0,0 +1,204 @@ +# ABSTRACT: helper for rendering HTTP status codes for Dancer2 + +package Dancer2::Core::HTTP; +$Dancer2::Core::HTTP::VERSION = '0.300000'; +use strict; +use warnings; + +use List::Util qw/ pairmap pairgrep /; + +my $HTTP_CODES = { + + # informational + 100 => 'Continue', # only on HTTP 1.1 + 101 => 'Switching Protocols', # only on HTTP 1.1 + 102 => 'Processing', # WebDAV; RFC 2518 + + # processed + 200 => 'OK', + 201 => 'Created', + 202 => 'Accepted', + 203 => 'Non-Authoritative Information', # only on HTTP 1.1 + 204 => 'No Content', + 205 => 'Reset Content', + 206 => 'Partial Content', + 207 => 'Multi-Status', # WebDAV; RFC 4918 + 208 => 'Already Reported', # WebDAV; RFC 5842 + # 226 => 'IM Used' # RFC 3229 + + # redirections + 301 => 'Moved Permanently', + 302 => 'Found', + 303 => 'See Other', # only on HTTP 1.1 + 304 => 'Not Modified', + 305 => 'Use Proxy', # only on HTTP 1.1 + 306 => 'Switch Proxy', + 307 => 'Temporary Redirect', # only on HTTP 1.1 + # 308 => 'Permanent Redirect' # approved as experimental RFC + + # problems with request + 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 Long', + 415 => 'Unsupported Media Type', + 416 => 'Requested Range Not Satisfiable', + 417 => 'Expectation Failed', + 418 => "I'm a teapot", # RFC 2324 + # 419 => 'Authentication Timeout', # not in RFC 2616 + 420 => 'Enhance Your Calm', + 422 => 'Unprocessable Entity', + 423 => 'Locked', + 424 => 'Failed Dependency', # Also used for 'Method Failure' + 425 => 'Unordered Collection', + 426 => 'Upgrade Required', + 428 => 'Precondition Required', + 429 => 'Too Many Requests', + 431 => 'Request Header Fields Too Large', + 444 => 'No Response', + 449 => 'Retry With', + 450 => 'Blocked by Windows Parental Controls', + 451 => 'Unavailable For Legal Reasons', + 494 => 'Request Header Too Large', + 495 => 'Cert Error', + 496 => 'No Cert', + 497 => 'HTTP to HTTPS', + 499 => 'Client Closed Request', + + # problems with server + 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', + 507 => 'Insufficient Storage', + 508 => 'Loop Detected', + 509 => 'Bandwidth Limit Exceeded', + 510 => 'Not Extended', + 511 => 'Network Authentication Required', + 598 => 'Network read timeout error', + 599 => 'Network connect timeout error', +}; + +$HTTP_CODES = { + %$HTTP_CODES, + ( reverse %$HTTP_CODES ), + pairmap { join( '_', split /\W/, lc $a ) => $b } reverse %$HTTP_CODES +}; + +$HTTP_CODES->{error} = $HTTP_CODES->{internal_server_error}; + +sub status { + my ( $class, $status ) = @_; + return if ! defined $status; + return $status if $status =~ /^\d+$/; + if ( exists $HTTP_CODES->{$status} ) { + return $HTTP_CODES->{$status}; + } + return; +} + +sub status_message { + my ( $class, $status ) = @_; + return if ! defined $status; + my $code = $class->status($status); + return if ! defined $code || ! exists $HTTP_CODES->{$code}; + return $HTTP_CODES->{ $code }; +} + +sub status_mapping { + pairgrep { $b =~ /^\d+$/ and $a !~ /_/ } %$HTTP_CODES; +} + +sub code_mapping { + my @result = reverse status_mapping(); + return @result; +} + +sub all_mappings { %$HTTP_CODES } + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::HTTP - helper for rendering HTTP status codes for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 FUNCTIONS + +=head2 status(status_code) + + Dancer2::Core::HTTP->status(200); # returns 200 + + Dancer2::Core::HTTP->status('Not Found'); # returns 404 + + Dancer2::Core::HTTP->status('bad_request'); # 400 + +Returns a HTTP status code. If given an integer, it will return the value it +received, else it will try to find the appropriate alias and return the correct +status. + +=head2 status_message(status_code) + + Dancer2::Core::HTTP->status_message(200); # returns 'OK' + + Dancer2::Core::HTTP->status_message('error'); # returns 'Internal Server Error' + +Returns the HTTP status message for the given status code. + +=head2 status_mapping() + + my %table = Dancer2::Core::HTTP->status_mapping; + # returns ( 'Ok' => 200, 'Created' => 201, ... ) + +Returns the full table of status -> code mappings. + +=head2 code_mapping() + + my %table = Dancer2::Core::HTTP->code_mapping; + # returns ( 200 => 'Ok', 201 => 'Created', ... ) + +Returns the full table of code -> status mappings. + +=head2 all_mappings() + + my %table = Dancer2::Core::HTTP->all_mappings; + # returns ( 418 => 'I'm a teapot', "I'm a teapot' => 418, 'i_m_a_teapot' => 418 ) + +Returns the code-to-status, status-to-code and underscore-groomed status-to-code mappings +all mashed up in a single table. Mostly for internal uses. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Hook.pm b/lib/Dancer2/Core/Hook.pm new file mode 100644 index 00000000..a97e43b7 --- /dev/null +++ b/lib/Dancer2/Core/Hook.pm @@ -0,0 +1,112 @@ +package Dancer2::Core::Hook; +# ABSTRACT: Manipulate hooks with Dancer2 +$Dancer2::Core::Hook::VERSION = '0.300000'; +use Moo; +use Dancer2::Core::Types; +use Carp; + +has name => ( + is => 'rw', + isa => Str, + required => 1, + coerce => sub { + my ($hook_name) = @_; + + # XXX at the moment, we have a filer position named "before_template". + # this one is renamed "before_template_render", so we need to alias it. + # maybe we need to deprecate 'before_template' to enforce the use + # of 'hook before_template_render => sub {}' ? + $hook_name = 'before_template_render' + if $hook_name eq 'before_template'; + return $hook_name; + }, +); + +has code => ( + is => 'ro', + isa => CodeRef, + required => 1, + coerce => sub { + my ($hook) = @_; + sub { + my $res; + eval { $res = $hook->(@_) }; + croak "Hook error: $@" if $@; + return $res; + }; + }, +); + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Hook - Manipulate hooks with Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + # inside a plugin + use Dancer2::Core::Hook; + Dancer2::Core::Hook->register_hooks_name(qw/before_auth after_auth/); + +=head1 METHODS + +=head2 register_hook ($hook_name, [$properties], $code) + + hook 'before', {apps => ['main']}, sub {...}; + + hook 'before' => sub {...}; + +Attaches a hook at some point, with a possible list of properties. + +Currently supported properties: + +=over 4 + +=item apps + + an array reference containing apps name + +=back + +=head2 register_hooks_name + +Add a new hook name, so application developers can insert some code at this point. + + package My::Dancer2::Plugin; + Dancer2::Core::Hook->instance->register_hooks_name(qw/before_auth after_auth/); + +=head2 execute_hook + +Execute a hooks + +=head2 get_hooks_for + +Returns the list of coderef registered for a given position + +=head2 hook_is_registered + +Test if a hook with this name has already been registered. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/MIME.pm b/lib/Dancer2/Core/MIME.pm new file mode 100644 index 00000000..ca4a70a6 --- /dev/null +++ b/lib/Dancer2/Core/MIME.pm @@ -0,0 +1,177 @@ +# ABSTRACT: Class to ease manipulation of MIME types + +package Dancer2::Core::MIME; +$Dancer2::Core::MIME::VERSION = '0.300000'; +use Moo; + +use Plack::MIME; +use Dancer2::Core::Types; +use Module::Runtime 'require_module'; + +# Initialise MIME::Types at compile time, to ensure it's done before +# the fork in a preforking webserver like mod_perl or Starman. Not +# doing this leads to all MIME types being returned as "text/plain", +# as MIME::Types fails to load its mappings from the DATA handle. See +# t/04_static_file/003_mime_types_reinit.t and GH#136. +BEGIN { + if ( eval { require_module('MIME::Types'); 1; } ) { + my $mime_types = MIME::Types->new(only_complete => 1); + Plack::MIME->set_fallback( + sub { + $mime_types->mimeTypeOf($_[0]) + } + ); + } +} + +has custom_types => ( + is => 'ro', + isa => HashRef, + default => sub { +{} }, +); + +has default => ( + is => 'rw', + isa => Str, + builder => "reset_default", +); + +sub reset_default { + my ($self) = @_; + $self->default("application/data"); +} + +sub add_type { + my ( $self, $name, $type ) = @_; + $self->custom_types->{$name} = $type; + return; +} + +sub add_alias { + my ( $self, $alias, $orig ) = @_; + my $type = $self->for_name($orig); + $self->add_type( $alias, $type ); + return $type; +} + +sub for_file { + my ( $self, $filename ) = @_; + my ($ext) = $filename =~ /\.([^.]+)$/; + return $self->default unless $ext; + return $self->for_name($ext); +} + +sub name_or_type { + my ( $self, $name ) = @_; + + return $name if $name =~ m{/}; # probably a mime type + return $self->for_name($name); +} + +sub for_name { + my ( $self, $name ) = @_; + + return + $self->custom_types->{ lc $name } + || Plack::MIME->mime_type( lc ".$name" ) + || $self->default; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::MIME - Class to ease manipulation of MIME types + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + use Dancer2::Core::MIME; + + my $mime = Dancer2::Core::MIME->new(); + + # get mime type for an alias + my $type = $mime->for_name('css'); + + # set a new mime type + my $type = $mime->add_type( foo => 'text/foo' ); + + # set a mime type alias + my $alias = $mime->add_alias( f => 'foo' ); + + # get mime type for a file (based on extension) + my $file = $mime->for_file( "foo.bar" ); + + # set the $thing into a content $type. + my $type = $mime->name_or_type($thing); + + # get current defined default mime type + my $type = $mime->default; + + # set the default mime type using config.yml + # or using the set keyword + set default_mime_type => 'text/plain'; + +=head1 DESCRIPTION + +Dancer2::Core::MIME is a thin wrapper around L<MIME::Types> providing helpful +methods for MIME handling. + +=head1 ATTRIBUTES + +=head2 custom_types + +Custom user-defined MIME types that are added the with C<add_type>. + +=head2 default + +Default MIME type defined by MIME::Types, set to: B<application/data>. + +=head1 METHODS + +=head2 reset_default + +This method resets C<mime_type> to the default type. + +=head2 add_type + +This method adds the new MIME type. + +=head2 add_alias + +The C<add_alias> sets a MIME type alias. + +=head2 for_name + +The method C<for_name> gets MIME type for an alias. + +=head2 for_file + +This method gets MIME type for a file based on extension. + +=head2 name_or_type + +This method sets the customized MIME name or default MIME type into a content +type. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Request.pm b/lib/Dancer2/Core/Request.pm new file mode 100644 index 00000000..f789f13c --- /dev/null +++ b/lib/Dancer2/Core/Request.pm @@ -0,0 +1,1148 @@ +package Dancer2::Core::Request; +# ABSTRACT: Interface for accessing incoming requests +$Dancer2::Core::Request::VERSION = '0.300000'; +use strict; +use warnings; +use parent 'Plack::Request'; + +use Carp; +use Encode; +use URI; +use URI::Escape; +use Safe::Isa; +use Hash::MultiValue; +use Module::Runtime 'require_module'; +use Ref::Util qw< is_ref is_arrayref is_hashref >; + +use Dancer2::Core::Types; +use Dancer2::Core::Request::Upload; +use Dancer2::Core::Cookie; + +# add an attribute for each HTTP_* variables +# (HOST is managed manually) +my @http_env_keys = (qw/ + accept_charset + accept_encoding + accept_language + connection + keep_alive + x_requested_with +/); + +# apparently you can't eval core functions +sub accept { $_[0]->env->{'HTTP_ACCEPT'} } + +eval << "_EVAL" or die $@ for @http_env_keys; ## no critic +sub $_ { \$_[0]->env->{ 'HTTP_' . ( uc "$_" ) } } +1; +_EVAL + +# check presence of XS module to speedup request +our $XS_URL_DECODE = eval { require_module('URL::Encode::XS'); 1; }; +our $XS_PARSE_QUERY_STRING = eval { require_module('CGI::Deurl::XS'); 1; }; +our $XS_HTTP_COOKIES = eval { require_module('HTTP::XSCookies'); 1; }; + +our $_id = 0; + +# self->new( env => {}, serializer => $s, is_behind_proxy => 0|1 ) +sub new { + my ( $class, @args ) = @_; + + # even sized list + @args % 2 == 0 + or croak 'Must provide even sized list'; + + my %opts = @args; + my $env = $opts{'env'}; + + my $self = $class->SUPER::new($env); + + if ( my $s = $opts{'serializer'} ) { + $s->$_does('Dancer2::Core::Role::Serializer') + or croak 'Serializer provided not a Serializer object'; + + $self->{'serializer'} = $s; + } + + # additionally supported attributes + $self->{'id'} = ++$_id; + $self->{'vars'} = {}; + $self->{'is_behind_proxy'} = !!$opts{'is_behind_proxy'}; + + $opts{'body_params'} + and $self->{'_body_params'} = $opts{'body_params'}; + + # Deserialize/parse body for HMV + $self->data; + $self->_build_uploads(); + + return $self; +} + +# a buffer for per-request variables +sub vars { $_[0]->{'vars'} } + +sub var { + my $self = shift; + @_ == 2 + ? $self->vars->{ $_[0] } = $_[1] + : $self->vars->{ $_[0] }; +} + +# I don't like this. I know send_file uses this and I wonder +# if we can remove it. +# -- Sawyer +sub set_path_info { $_[0]->env->{'PATH_INFO'} = $_[1] } + +# XXX: incompatible with Plack::Request +sub body { $_[0]->raw_body } + +sub id { $_id } + +# Private 'read-only' attributes for request params. See the params() +# method for the public interface. +# +# _body_params, _query_params and _route_params have setter methods that +# decode byte string to characters before setting; If you know you have +# decoded (character) params, such as output from a deserializer, you can +# set these directly in the request object hash to avoid the decode op. +sub _params { $_[0]->{'_params'} ||= $_[0]->_build_params } + +sub _has_params { defined $_[0]->{'_params'} } + +sub _body_params { $_[0]->{'_body_params'} ||= $_[0]->body_parameters->as_hashref_mixed } + +sub _query_params { $_[0]->{'_query_params'} } + +sub _set_query_params { + my ( $self, $params ) = @_; + $self->{_query_params} = _decode( $params ); +} + +sub _route_params { $_[0]->{'_route_params'} ||= {} } + +sub _set_route_params { + my ( $self, $params ) = @_; + $self->{_route_params} = _decode( $params ); + $self->_build_params(); +} + +# XXX: incompatible with Plack::Request +sub uploads { $_[0]->{'uploads'} } + +sub is_behind_proxy { $_[0]->{'is_behind_proxy'} || 0 } + +sub host { + my ($self) = @_; + + if ( $self->is_behind_proxy and exists $self->env->{'HTTP_X_FORWARDED_HOST'} ) { + my @hosts = split /\s*,\s*/, $self->env->{'HTTP_X_FORWARDED_HOST'}, 2; + return $hosts[0]; + } else { + return $self->env->{'HTTP_HOST'}; + } +} + +# aliases, kept for backward compat +sub agent { shift->user_agent } +sub remote_address { shift->address } +sub forwarded_for_address { shift->env->{'HTTP_X_FORWARDED_FOR'} } +sub forwarded_host { shift->env->{'HTTP_X_FORWARDED_HOST'} } + +# there are two options +sub forwarded_protocol { + $_[0]->env->{'HTTP_X_FORWARDED_PROTO'} || + $_[0]->env->{'HTTP_X_FORWARDED_PROTOCOL'} || + $_[0]->env->{'HTTP_FORWARDED_PROTO'} +} + +sub scheme { + my ($self) = @_; + my $scheme = $self->is_behind_proxy + ? $self->forwarded_protocol + : ''; + + return $scheme || $self->env->{'psgi.url_scheme'}; +} + +sub serializer { $_[0]->{'serializer'} } + +sub data { $_[0]->{'data'} ||= $_[0]->deserialize() } + +sub deserialize { + my $self = shift; + + my $serializer = $self->serializer + or return; + + # The latest draft of the RFC does not forbid DELETE to have content, + # rather the behaviour is undefined. Take the most lenient route and + # deserialize any content on delete as well. + return + unless grep { $self->method eq $_ } qw/ PUT POST PATCH DELETE /; + + # try to deserialize + my $body = $self->body; + + $body && length $body > 0 + or return; + + # Catch serializer fails - which is tricky as Role::Serializer + # wraps the deserializaion in an eval and returns undef. + # We want to generate a 500 error on serialization fail (Ref #794) + # to achieve that, override the log callback so we can catch a signal + # that it failed. This is messy (messes with serializer internals), but + # "works". + my $serializer_fail; + my $serializer_log_cb = $serializer->log_cb; + local $serializer->{log_cb} = sub { + $serializer_fail = $_[1]; + $serializer_log_cb->(@_); + }; + # work-around to resolve a chicken-and-egg issue when instantiating a + # request object; the serializer needs that request object to deserialize + # the body params. + Scalar::Util::weaken( my $request = $self ); + $self->serializer->has_request || $self->serializer->set_request($request); + my $data = $serializer->deserialize($body); + die $serializer_fail if $serializer_fail; + + # Set _body_params directly rather than using the setter. Deserializiation + # returns characters and skipping the decode op in the setter ensures + # that numerical data "stays" numerical; decoding an SV that is an IV + # converts that to a PVIV. Some serializers are picky (JSON).. + $self->{_body_params} = $data; + + # Set body parameters (decoded HMV) + $self->{'body_parameters'} = + Hash::MultiValue->from_mixed( is_hashref($data) ? %$data : () ); + + return $data; +} + +sub uri { $_[0]->request_uri } + +sub is_head { $_[0]->method eq 'HEAD' } +sub is_post { $_[0]->method eq 'POST' } +sub is_get { $_[0]->method eq 'GET' } +sub is_put { $_[0]->method eq 'PUT' } +sub is_delete { $_[0]->method eq 'DELETE' } +sub is_patch { $_[0]->method eq 'PATCH' } +sub is_options { $_[0]->method eq 'OPTIONS' } + +# public interface compat with CGI.pm objects +sub request_method { $_[0]->method } +sub input_handle { $_[0]->env->{'psgi.input'} } + +sub to_string { + my ($self) = @_; + return "[#" . $self->id . "] " . $self->method . " " . $self->path; +} + +sub base { + my $self = shift; + my $uri = $self->_common_uri; + + return $uri->canonical; +} + +sub _common_uri { + my $self = shift; + + my $path = $self->env->{SCRIPT_NAME}; + my $port = $self->env->{SERVER_PORT}; + my $server = $self->env->{SERVER_NAME}; + my $host = $self->host; + my $scheme = $self->scheme; + + my $uri = URI->new; + $uri->scheme($scheme); + $uri->authority( $host || "$server:$port" ); + $uri->path( $path || '/' ); + + return $uri; +} + +sub uri_base { + my $self = shift; + my $uri = $self->_common_uri; + my $canon = $uri->canonical; + + if ( $uri->path eq '/' ) { + $canon =~ s{/$}{}; + } + + return $canon; +} + +sub dispatch_path { + warn q{request->dispatch_path is deprecated}; + return shift->path; +} + +sub uri_for { + my ( $self, $part, $params, $dont_escape ) = @_; + + $part ||= ''; + my $uri = $self->base; + + # Make sure there's exactly one slash between the base and the new part + my $base = $uri->path; + $base =~ s|/$||; + $part =~ s|^/||; + $uri->path("$base/$part"); + + $uri->query_form($params) if $params; + + return $dont_escape + ? uri_unescape( ${ $uri->canonical } ) + : ${ $uri->canonical }; +} + +sub params { + my ( $self, $source ) = @_; + + return %{ $self->_params } if wantarray && @_ == 1; + return $self->_params if @_ == 1; + + if ( $source eq 'query' ) { + return %{ $self->_query_params || {} } if wantarray; + return $self->_query_params; + } + elsif ( $source eq 'body' ) { + return %{ $self->_body_params || {} } if wantarray; + return $self->_body_params; + } + if ( $source eq 'route' ) { + return %{ $self->_route_params } if wantarray; + return $self->_route_params; + } + else { + croak "Unknown source params \"$source\"."; + } +} + +sub query_parameters { + my $self = shift; + $self->{'query_parameters'} ||= do { + if ($XS_PARSE_QUERY_STRING) { + my $query = _decode(CGI::Deurl::XS::parse_query_string( + $self->env->{'QUERY_STRING'} + )); + + Hash::MultiValue->new( + map {; + my $key = $_; + is_arrayref( $query->{$key} ) + ? ( map +( $key => $_ ), @{ $query->{$key} } ) + : ( $key => $query->{$key} ) + } keys %{$query} + ); + } else { + # defer to Plack::Request + _decode($self->SUPER::query_parameters); + } + }; +} + +# this will be filled once the route is matched +sub route_parameters { $_[0]->{'route_parameters'} ||= Hash::MultiValue->new } + +sub _set_route_parameters { + my ( $self, $params ) = @_; + # remove reserved splat parameter name + # you should access splat parameters using splat() keyword + delete @{$params}{qw<splat captures>}; + $self->{'route_parameters'} = Hash::MultiValue->from_mixed( %{_decode($params)} ); +} + +sub body_parameters { + my $self = shift; + # defer to (the overridden) Plack::Request->body_parameters + $self->{'body_parameters'} ||= _decode($self->SUPER::body_parameters()); +} + +sub parameters { + my ( $self, $type ) = @_; + + # handle a specific case + if ($type) { + my $attr = "${type}_parameters"; + return $self->$attr; + } + + # merge together the *decoded* parameters + $self->{'merged_parameters'} ||= do { + my $query = $self->query_parameters; + my $body = $self->body_parameters; + my $route = $self->route_parameters; # not in Plack::Request + Hash::MultiValue->new( map $_->flatten, $query, $body, $route ); + }; +} + +sub captures { shift->params->{captures} || {} } + +sub splat { @{ shift->params->{splat} || [] } } + +# XXX: incompatible with Plack::Request +sub param { shift->params->{ $_[0] } } + +sub _decode { + my ($h) = @_; + return if not defined $h; + + if ( !is_ref($h) && !utf8::is_utf8($h) ) { + return decode( 'UTF-8', $h ); + } + elsif ( ref($h) eq 'Hash::MultiValue' ) { + return Hash::MultiValue->from_mixed(_decode($h->as_hashref_mixed)); + } + elsif ( is_hashref($h) ) { + return { map {my $t = _decode($_); $t} (%$h) }; + } + elsif ( is_arrayref($h) ) { + return [ map _decode($_), @$h ]; + } + + return $h; +} + +sub is_ajax { + my $self = shift; + + return 0 unless defined $self->headers; + return 0 unless defined $self->header('X-Requested-With'); + return 0 if $self->header('X-Requested-With') ne 'XMLHttpRequest'; + return 1; +} + +# XXX incompatible with Plack::Request +# context-aware accessor for uploads +sub upload { + my ( $self, $name ) = @_; + my $res = $self->{uploads}{$name}; + + return $res unless wantarray; + return () unless defined $res; + return ( is_arrayref($res) ) ? @$res : $res; +} + +sub _build_params { + my ($self) = @_; + + # params may have been populated by before filters + # _before_ we get there, so we have to save it first + my $previous = $self->_has_params ? $self->_params : {}; + + # now parse environment params... + my $get_params = $self->_parse_get_params(); + + # and merge everything + $self->{_params} = { + map +( is_hashref($_) ? %{$_} : () ), + $previous, + $get_params, + $self->_body_params, + $self->_route_params, + }; + +} + +sub _url_decode { + my ( $self, $encoded ) = @_; + return URL::Encode::XS::url_decode($encoded) if $XS_URL_DECODE; + my $clean = $encoded; + $clean =~ tr/\+/ /; + $clean =~ s/%([a-fA-F0-9]{2})/pack "H2", $1/eg; + return $clean; +} + +sub _parse_get_params { + my ($self) = @_; + return $self->_query_params if defined $self->{_query_params}; + + my $query_params = {}; + + my $source = $self->env->{QUERY_STRING}; + return if !defined $source || $source eq ''; + + if ($XS_PARSE_QUERY_STRING) { + $self->_set_query_params( + CGI::Deurl::XS::parse_query_string($source) || {} + ); + return $self->_query_params; + } + + foreach my $token ( split /[&;]/, $source ) { + my ( $key, $val ) = split( /=/, $token ); + next unless defined $key; + $val = ( defined $val ) ? $val : ''; + $key = $self->_url_decode($key); + $val = $self->_url_decode($val); + + # looking for multi-value params + if ( exists $query_params->{$key} ) { + my $prev_val = $query_params->{$key}; + if ( is_arrayref($prev_val) ) { + push @{ $query_params->{$key} }, $val; + } + else { + $query_params->{$key} = [ $prev_val, $val ]; + } + } + + # simple value param (first time we see it) + else { + $query_params->{$key} = $val; + } + } + $self->_set_query_params( $query_params ); + return $self->_query_params; +} + +sub _build_uploads { + my ($self) = @_; + + # parse body and build body params + my $body_params = $self->_body_params; + + my $uploads = $self->SUPER::uploads; + my %uploads; + + for my $name ( keys %$uploads ) { + my @uploads = map Dancer2::Core::Request::Upload->new( + # For back-compatibility, we use a HashRef of headers + headers => {@{$_->{headers}->psgi_flatten_without_sort}}, + tempname => $_->{tempname}, + size => $_->{size}, + filename => _decode( $_->{filename} ), + ), $uploads->get_all($name); + + $uploads{$name} = @uploads > 1 ? \@uploads : $uploads[0]; + + # support access to the filename as a normal param + my @filenames = map $_->{'filename'}, @uploads; + $self->{_body_params}{$name} = + @filenames > 1 ? \@filenames : $filenames[0]; + } + + $self->{uploads} = \%uploads; +} + +# XXX: incompatible with Plack::Request +sub cookies { $_[0]->{'cookies'} ||= $_[0]->_build_cookies } + +sub _build_cookies { + my $self = shift; + my $cookies = {}; + + my $http_cookie = $self->header('Cookie'); + return $cookies unless defined $http_cookie; # nothing to do + + if ( $XS_HTTP_COOKIES ) { + $cookies = HTTP::XSCookies::crush_cookie($http_cookie); + } + else { + # handle via Plack::Request + $cookies = $self->SUPER::cookies(); + } + + # convert to objects + while (my ($name, $value) = each %{$cookies}) { + $cookies->{$name} = Dancer2::Core::Cookie->new( + name => $name, + # HTTP::XSCookies v0.17+ will do the split and return an arrayref + value => (is_arrayref($value) ? $value : [split(/[&;]/, $value)]) + ); + } + return $cookies; +} + +# poor man's clone +sub _shallow_clone { + my ($self, $params, $options) = @_; + + # shallow clone $env; we don't want to alter the existing one + # in $self, then merge any overridden values + my $env = { %{ $self->env }, %{ $options || {} } }; + + my $new_request = __PACKAGE__->new( + env => $env, + body_params => {}, + ); + + # Clone and merge query params + my $new_params = $self->params; + $new_request->{_query_params} = { %{ $self->{_query_params} || {} } }; + $new_request->{query_parameters} = $self->query_parameters->clone; + for my $key ( keys %{ $params || {} } ) { + my $value = $params->{$key}; + $new_params->{$key} = $value; + $new_request->{_query_params}->{$key} = $value; + $new_request->{query_parameters}->add( $key => $value ); + } + + # Copy params (these are already decoded) + $new_request->{_params} = $new_params; + $new_request->{_body_params} = $self->{_body_params}; + $new_request->{_route_params} = $self->{_route_params}; + $new_request->{headers} = $self->headers; + + # Copy remaining settings + $new_request->{is_behind_proxy} = $self->{is_behind_proxy}; + $new_request->{vars} = $self->{vars}; + + # Clone any existing decoded & cached body params. (GH#1116 GH#1269) + $new_request->{'body_parameters'} = $self->body_parameters->clone; + + # Delete merged HMV parameters, allowing them to be reconstructed on first use. + delete $new_request->{'merged_parameters'}; + + return $new_request; +} + + +sub _set_route { + my ( $self, $route ) = @_; + $self->{'route'} = $route; +} + +sub route { $_[0]->{'route'} } + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Request - Interface for accessing incoming requests + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + +In a route handler, the current request object can be accessed by the +C<request> keyword: + + get '/foo' => sub { + request->params; # request, params parsed as a hash ref + request->body; # returns the request body, unparsed + request->path; # the path requested by the client + # ... + }; + +=head1 DESCRIPTION + +An object representing a Dancer2 request. It aims to provide a proper +interface to anything you might need from a web request. + +=head1 METHODS + +=head2 address + +Return the IP address of the client. + +=head2 base + +Returns an absolute URI for the base of the application. Returns a L<URI> +object (which stringifies to the URL, as you'd expect). + +=head2 body_parameters + +Returns a L<Hash::MultiValue> object representing the POST parameters. + +=head2 body + +Return the raw body of the request, unparsed. + +If you need to access the body of the request, you have to use this accessor and +should not try to read C<psgi.input> by hand. C<Dancer2::Core::Request> +already did it for you and kept the raw body untouched in there. + +=head2 content + +Returns the undecoded byte string POST body. + +=head2 cookies + +Returns a reference to a hash containing cookies, where the keys are the names of the +cookies and values are L<Dancer2::Core::Cookie> objects. + +=head2 data + +If the application has a serializer and if the request has serialized +content, returns the deserialized structure as a hashref. + +=head2 dispatch_path + +Alias for L<path>. Deprecated. + +=head2 env + +Return the current PSGI environment hash reference. + +=head2 header($name) + +Return the value of the given header, if present. If the header has multiple +values, returns an the list of values if called in list context, the first one +in scalar. + +=head2 headers + +Returns either an L<HTTP::Headers> or an L<HTTP::Headers::Fast> object +representing the headers. + +=head2 id + +The ID of the request. This allows you to trace a specific request in loggers, +per the string created using C<to_string>. + +The ID of the request is essentially the number of requests run in the current +class. + +=head2 input + +Alias to C<input_handle> method below. + +=head2 input_handle + +Alias to the PSGI input handle (C<< <request->env->{psgi.input}> >>) + +=head2 is_ajax + +Return true if the value of the header C<X-Requested-With> is +C<XMLHttpRequest>. + +=head2 is_delete + +Return true if the method requested by the client is 'DELETE' + +=head2 is_get + +Return true if the method requested by the client is 'GET' + +=head2 is_head + +Return true if the method requested by the client is 'HEAD' + +=head2 is_post + +Return true if the method requested by the client is 'POST' + +=head2 is_put + +Return true if the method requested by the client is 'PUT' + +=head2 is_options + +Return true if the method requested by the client is 'OPTIONS' + +=head2 logger + +Returns the C<psgix.logger> code reference, if exists. + +=head2 method + +Return the HTTP method used by the client to access the application. + +While this method returns the method string as provided by the environment, it's +better to use one of the following boolean accessors if you want to inspect the +requested method. + +=head2 new + +The constructor of the class, used internally by Dancer2's core to create request +objects. + +It uses the environment hash table given to build the request object: + + Dancer2::Core::Request->new( env => $env ); + +There are two additional parameters for instantiation: + +=over 4 + +=item * serializer + +A serializer object to work with when reading the request body. + +=item * body_params + +Provide body parameters. + +Used internally when we need to avoid parsing the body again. + +=back + +=head2 param($key) + +Calls the C<params> method below and fetches the key provided. + +=head2 params($source) + +Called in scalar context, returns a hashref of params, either from the specified +source (see below for more info on that) or merging all sources. + +So, you can use, for instance: + + my $foo = params->{foo} + +If called in list context, returns a list of key and value pairs, so you could use: + + my %allparams = params; + +Parameters are merged in the following order: query, body, route - i.e. route +parameters have the highest priority: + + POST /hello/Ruth?name=Quentin + + name=Bobbie + + post '/hello/:name' => sub { + return "Hello, " . route_parameters->get('name') . "!"; # returns Ruth + return "Hello, " . query_parameters->get('name') . "!"; # returns Quentin + return "Hello, " . body_parameters->get('name') . "!"; # returns Bobbie + return "Hello, " . param('name') . "!"; # returns Ruth + }; + +The L</query_parameters>, L</route_parameters>, and L</body_parameters> keywords +provide a L<Hash::MultiValue> result from the three different parameters. +We recommend using these rather than C<params>, because of the potential for +unintentional behaviour - consider the following request and route handler: + + POST /artist/104/new-song + + name=Careless Dancing + + post '/artist/:id/new-song' => sub { + find_artist(param('id'))->create_song(params); + # oops! we just passed id into create_song, + # but we probably only intended to pass name + find_artist(param('id'))->create_song(body_parameters); + }; + + POST /artist/104/join-band + + id=4 + name=Dancing Misfits + + post '/artist/:id/new-song' => sub { + find_artist(param('id'))->join_band(params); + # oops! we just passed an id of 104 into join_band, + # but we probably should have passed an id of 4 + }; + +=head2 parameters + +Returns a L<Hash::MultiValue> object with merged GET and POST parameters. + +Parameters are merged in the following order: query, body, route - i.e. route +parameters have the highest priority - see L</params> for how this works, and +associated risks and alternatives. + +=head2 path + +The path requested by the client, normalized. This is effectively +C<path_info> or a single forward C</>. + +=head2 path_info + +The raw requested path. This could be empty. Use C<path> instead. + +=head2 port + +Return the port of the server. + +=head2 protocol + +Return the protocol (I<HTTP/1.0> or I<HTTP/1.1>) used for the request. + +=head2 query_parameters + +Returns a L<Hash::MultiValue> parameters object. + +=head2 query_string + +Returns the portion of the request defining the query itself - this is +what comes after the C<?> in a URI. + +=head2 raw_body + +Alias to C<content> method. + +=head2 remote_address + +Alias for C<address> method. + +=head2 remote_host + +Return the remote host of the client. This only works with web servers configured +to do a reverse DNS lookup on the client's IP address. + +=head2 request_method + +Alias to the C<method> accessor, for backward-compatibility with C<CGI> interface. + +=head2 request_uri + +Return the raw, undecoded request URI path. + +=head2 route + +Return the L<route|Dancer2::Core::Route> which this request matched. + +=head2 scheme + +Return the scheme of the request + +=head2 script_name + +Return script_name from the environment. + +=head2 secure + +Return true or false, indicating whether the connection is secure - this is +effectively checking if the scheme is I<HTTPS> or not. + +=head2 serializer + +Returns the optional serializer object used to deserialize request parameters. + +=head2 session + +Returns the C<psgix.session> hash, if exists. + +=head2 session_options + +Returns the C<psgix.session.options> hash, if exists. + +=head2 to_string + +Return a string representing the request object (e.g., C<GET /some/path>). + +=head2 upload($name) + +Context-aware accessor for uploads. It's a wrapper around an access to the hash +table provided by C<uploads()>. It looks at the calling context and returns a +corresponding value. + +If you have many file uploads under the same name, and call C<upload('name')> in +an array context, the accessor will unroll the ARRAY ref for you: + + my @uploads = request->upload('many_uploads'); # OK + +Whereas with a manual access to the hash table, you'll end up with one element +in C<@uploads>, being the arrayref: + + my @uploads = request->uploads->{'many_uploads'}; + # $uploads[0]: ARRAY(0xXXXXX) + +That is why this accessor should be used instead of a manual access to +C<uploads>. + +=head2 uploads + +Returns a reference to a hash containing uploads. Values can be either a +L<Dancer2::Core::Request::Upload> object, or an arrayref of +L<Dancer2::Core::Request::Upload> +objects. + +You should probably use the C<upload($name)> accessor instead of manually accessing the +C<uploads> hash table. + +=head2 uri + +An alias to C<request_uri>. + +=head2 uri_base + +Same thing as C<base> above, except it removes the last trailing slash in the +path if it is the only path. + +This means that if your base is I<http://myserver/>, C<uri_base> will return +I<http://myserver> (notice no trailing slash). This is considered very useful +when using templates to do the following thing: + + <link rel="stylesheet" href="[% request.uri_base %]/css/style.css" /> + +=head2 uri_for(path, params) + +Constructs a URI from the base and the passed path. If params (hashref) is +supplied, these are added to the query string of the URI. + +Thus, with the following base: + + http://localhost:5000/foo + +You get the following behavior: + + my $uri = request->uri_for('/bar', { baz => 'baz' }); + print $uri; # http://localhost:5000/foo/bar?baz=baz + +C<uri_for> returns a L<URI> object (which can stringify to the value). + +=head2 user + +Return remote user if defined. + +=head2 var + +By-name interface to variables stored in this request object. + + my $stored = $request->var('some_variable'); + +returns the value of 'some_variable', while + + $request->var('some_variable' => 'value'); + +will set it. + +=head2 vars + +Access to the internal hash of variables: + + my $value = $request->vars->{'my_key'}; + +You want to use C<var> above. + +=head1 Common HTTP request headers + +Commonly used client-supplied HTTP request headers are available through +specific accessors: + +=over 4 + +=item C<accept> + +HTTP header: C<HTTP_ACCEPT>. + +=item C<accept_charset> + +HTTP header: C<HTTP_ACCEPT_CHARSET>. + +=item C<accept_encoding> + +HTTP header: C<HTTP_ACCEPT_ENCODING>. + +=item C<accept_language> + +HTTP header: C<HTTP_ACCEPT_LANGUAGE>. + +=item C<agent> + +Alias for C<user_agent>) below. + +=item C<connection> + +HTTP header: C<HTTP_CONNECTION>. + +=item C<content_encoding> + +HTTP header: C<HTTP_CONTENT_ENCODING>. + +=item C<content_length> + +HTTP header: C<HTTP_CONTENT_LENGTH>. + +=item C<content_type> + +HTTP header: C<HTTP_CONTENT_TYPE>. + +=item C<forwarded_for_address> + +HTTP header: C<HTTP_X_FORWARDED_FOR>. + +=item C<forwarded_host> + +HTTP header: C<HTTP_X_FORWARDED_HOST>. + +=item C<forwarded_protocol> + +One of either C<HTTP_X_FORWARDED_PROTOCOL>, C<HTTP_X_FORWARDED_PROTO>, or +C<HTTP_FORWARDED_PROTO>. + +=item C<host> + +Checks whether we are behind a proxy using the C<behind_proxy> +configuration option, and if so returns the first +C<HTTP_X_FORWARDED_HOST>, since this is a comma separated list. + +If you have not configured that you are behind a proxy, it returns HTTP +header C<HTTP_HOST>. + +=item C<keep_alive> + +HTTP header: C<HTTP_KEEP_ALIVE>. + +=item C<referer> + +HTTP header: C<HTTP_REFERER>. + +=item C<user_agent> + +HTTP header: C<HTTP_USER_AGENT>. + +=item C<x_requested_with> + +HTTP header: C<HTTP_X_REQUESTED_WITH>. + +=back + +=head1 Fetching only params from a given source + +If a required source isn't specified, a mixed hashref (or list of key value +pairs, in list context) will be returned; this will contain params from all +sources (route, query, body). + +In practical terms, this means that if the param C<foo> is passed both on the +querystring and in a POST body, you can only access one of them. + +If you want to see only params from a given source, you can say so by passing +the C<$source> param to C<params()>: + + my %querystring_params = params('query'); + my %route_params = params('route'); + my %post_params = params('body'); + +If source equals C<route>, then only params parsed from the route pattern +are returned. + +If source equals C<query>, then only params parsed from the query string are +returned. + +If source equals C<body>, then only params sent in the request body will be +returned. + +If another value is given for C<$source>, then an exception is triggered. + +=head1 EXTRA SPEED + +If L<Dancer2::Core::Request> detects the following modules as installed, +it will use them to speed things up: + +=over 4 + +=item * L<URL::Encode::XS> + +=item * L<CGI::Deurl::XS> + +=back + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Request/Upload.pm b/lib/Dancer2/Core/Request/Upload.pm new file mode 100644 index 00000000..43b9ab48 --- /dev/null +++ b/lib/Dancer2/Core/Request/Upload.pm @@ -0,0 +1,178 @@ +package Dancer2::Core::Request::Upload; +# ABSTRACT: Class representing file upload requests +$Dancer2::Core::Request::Upload::VERSION = '0.300000'; +use Moo; + +use Carp; +use File::Spec; +use Module::Runtime 'require_module'; + +use Dancer2::Core::Types; +use Dancer2::FileUtils qw(open_file); + +has filename => ( + is => 'ro', + isa => Str, +); + +has tempname => ( + is => 'ro', + isa => Str, +); + +has headers => ( + is => 'ro', + isa => HashRef, +); + +has size => ( + is => 'ro', + isa => Num, +); + +sub file_handle { + my ($self) = @_; + return $self->{_fh} if defined $self->{_fh}; + my $fh = open_file( '<', $self->tempname ); + $self->{_fh} = $fh; +} + +sub copy_to { + my ( $self, $target ) = @_; + require_module('File::Copy'); + File::Copy::copy( $self->tempname, $target ); +} + +sub link_to { + my ( $self, $target ) = @_; + CORE::link( $self->tempname, $target ); +} + +sub content { + my ( $self, $layer ) = @_; + return $self->{_content} + if defined $self->{_content}; + + $layer = ':raw' unless $layer; + + my $content = undef; + my $handle = $self->file_handle; + + binmode( $handle, $layer ); + + while ( $handle->read( my $buffer, 8192 ) ) { + $content .= $buffer; + } + + $self->{_content} = $content; +} + +sub basename { + my ($self) = @_; + require_module('File::Basename'); + File::Basename::basename( $self->filename ); +} + +sub type { + my $self = shift; + return $self->headers->{'Content-Type'}; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Request::Upload - Class representing file upload requests + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This class implements a representation of file uploads for Dancer2. +These objects are accessible within route handlers via the request->uploads +keyword. See L<Dancer2::Core::Request> for details. + +=head1 ATTRIBUTES + +=head2 filename + +Filename as sent by client. optional. May not be undef. + +=head2 tempname + +The name of the temporary file the data has been saved to. Optional. May not be undef. + +=head2 headers + +A hash ref of the headers associated with this upload. optional. is read-write and a HashRef. + +=head2 size + +The size of the upload, in bytes. Optional. + +=head1 METHODS + +=head2 my $filename=$upload->filename; + +Returns the filename (full path) as sent by the client. + +=head2 my $tempname=$upload->tempname; + +Returns the name of the temporary file the data has been saved to. + +For example, in directory /tmp, and given a random name, with no file extension. + +=head2 my $href=$upload->headers; + +Returns a hashRef of the headers associated with this upload. + +=head2 my $fh=$upload->file_handle; + +Returns a read-only file handle on the temporary file. + +=head2 $upload->copy_to('/path/to/target') + +Copies the temporary file using File::Copy. Returns true for success, +false for failure. + +=head2 $upload->link_to('/path/to/target'); + +Creates a hard link to the temporary file. Returns true for success, +false for failure. + +=head2 my $content=$upload->content; + +Returns a scalar containing the contents of the temporary file. + +=head2 my $basename=$upload->basename; + +Returns basename for "filename". + +=head2 $upload->type + +Returns the Content-Type of this upload. + +=head1 SEE ALSO + +L<Dancer2> + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Response.pm b/lib/Dancer2/Core/Response.pm new file mode 100644 index 00000000..d8be82dd --- /dev/null +++ b/lib/Dancer2/Core/Response.pm @@ -0,0 +1,406 @@ +# ABSTRACT: Response object for Dancer2 + +package Dancer2::Core::Response; +$Dancer2::Core::Response::VERSION = '0.300000'; +use Moo; + +use Encode; +use Dancer2::Core::Types; + +use Dancer2 (); +use Dancer2::Core::HTTP; + +use HTTP::Headers::Fast; +use Scalar::Util qw(blessed); +use Plack::Util; +use Safe::Isa; +use Sub::Quote (); + +use overload + '@{}' => sub { $_[0]->to_psgi }, + '""' => sub { $_[0] }; + +has headers => ( + is => 'ro', + isa => InstanceOf['HTTP::Headers'], + lazy => 1, + coerce => sub { + my ($value) = @_; + # HTTP::Headers::Fast reports that it isa 'HTTP::Headers', + # but there is no actual inheritance. + $value->$_isa('HTTP::Headers') + ? $value + : HTTP::Headers::Fast->new(@{$value}); + }, + default => sub { + HTTP::Headers::Fast->new(); + }, + handles => [qw<header push_header>], +); + +sub headers_to_array { + my $self = shift; + my $headers = shift || $self->headers; + + my @hdrs; + $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 @hdrs, $k => $v; + }); + + return \@hdrs; +} + +# boolean to tell if the route passes or not +has has_passed => ( + is => 'rw', + isa => Bool, + default => sub {0}, +); + +sub pass { shift->has_passed(1) } + +has serializer => ( + is => 'ro', + isa => ConsumerOf ['Dancer2::Core::Role::Serializer'], +); + +has is_encoded => ( + is => 'rw', + isa => Bool, + default => sub {0}, +); + +has is_halted => ( + is => 'rw', + isa => Bool, + default => sub {0}, +); + +sub halt { + my ( $self, $content ) = @_; + $self->content( $content ) if @_ > 1; + $self->is_halted(1); +} + +has status => ( + is => 'rw', + isa => Num, + default => sub {200}, + lazy => 1, + coerce => sub { Dancer2::Core::HTTP->status(shift) }, +); + +has content => ( + is => 'rw', + isa => Str, + predicate => 'has_content', + clearer => 'clear_content', +); + +has server_tokens => ( + is => 'ro', + isa => Bool, + default => sub {1}, +); + +around content => sub { + my ( $orig, $self ) = ( shift, shift ); + + # called as getter? + @_ or return $self->$orig; + + # No serializer defined; encode content + $self->serializer + or return $self->$orig( $self->encode_content(@_) ); + + # serialize content + my $serialized = $self->serialize(@_); + $self->is_encoded(1); # All serializers return byte strings + return $self->$orig( defined $serialized ? $serialized : '' ); +}; + +has default_content_type => ( + is => 'rw', + isa => Str, + default => sub {'text/html'}, +); + +sub encode_content { + my ( $self, $content ) = @_; + + return $content if $self->is_encoded; + + # Apply default content type if none set. + my $ct = $self->content_type || + $self->content_type( $self->default_content_type ); + + return $content if $ct !~ /^text/; + + # we don't want to encode an empty string, it will break the output + $content or return $content; + + $self->content_type("$ct; charset=UTF-8") + if $ct !~ /charset/; + + $self->is_encoded(1); + return Encode::encode( 'UTF-8', $content ); +} + +sub new_from_plack { + my ($self, $psgi_res) = @_; + + return Dancer2::Core::Response->new( + status => $psgi_res->status, + headers => $psgi_res->headers, + content => $psgi_res->body, + ); +} + +sub new_from_array { + my ($self, $arrayref) = @_; + + return Dancer2::Core::Response->new( + status => $arrayref->[0], + headers => $arrayref->[1], + content => $arrayref->[2][0], + ); +} + +sub to_psgi { + my ($self) = @_; + + $self->server_tokens + and $self->header( 'Server' => "Perl Dancer2 " . Dancer2->VERSION ); + + my $headers = $self->headers; + my $status = $self->status; + + Plack::Util::status_with_no_entity_body($status) + and return [ $status, $self->headers_to_array($headers), [] ]; + + my $content = $self->content; + # It is possible to have no content and/or no content type set + # e.g. if all routes 'pass'. Set the default value for the content + # (an empty string), allowing serializer hooks to be triggered + # as they may change the content.. + $content = $self->content('') if ! defined $content; + + if ( !$headers->header('Content-Length') && + !$headers->header('Transfer-Encoding') && + defined( my $content_length = length $content ) ) { + $headers->push_header( 'Content-Length' => $content_length ); + } + + # More defaults + $self->content_type or $self->content_type($self->default_content_type); + return [ $status, $self->headers_to_array($headers), [ $content ], ]; +} + +# sugar for accessing the content_type header, with mimetype care +sub content_type { + my $self = shift; + + if ( scalar @_ > 0 ) { + my $runner = Dancer2::runner(); + my $mimetype = $runner->mime_type->name_or_type(shift); + $self->header( 'Content-Type' => $mimetype ); + return $mimetype; + } + else { + return $self->header('Content-Type'); + } +} + +has _forward => ( + is => 'rw', + isa => HashRef, +); + +sub forward { + my ( $self, $uri, $params, $opts ) = @_; + $self->_forward( { to_url => $uri, params => $params, options => $opts } ); +} + +sub is_forwarded { + my $self = shift; + $self->_forward; +} + +sub redirect { + my ( $self, $destination, $status ) = @_; + $self->status( $status || 302 ); + + # we want to stringify the $destination object (URI object) + $self->header( 'Location' => "$destination" ); +} + +sub error { + my $self = shift; + + my $error = Dancer2::Core::Error->new( + response => $self, + @_, + ); + + $error->throw; + return $error; +} + +sub serialize { + my ($self, $content) = @_; + + my $serializer = $self->serializer + or return; + + $content = $serializer->serialize($content) + or return; + + $self->content_type( $serializer->content_type ); + return $content; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Response - Response object for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 ATTRIBUTES + +=head2 is_encoded + +Flag to tell if the content has already been encoded. + +=head2 is_halted + +Flag to tell whether or not the response should continue to be processed. + +=head2 status + +The HTTP status for the response. + +=head2 content + +The content for the response, stored as a string. If a reference is passed, the +response will try coerce it to a string via double quote interpolation. + +=head2 default_content_type + +Default mime type to use for the response Content-Type header +if nothing was specified + +=head2 headers + +The attribute that store the headers in a L<HTTP::Headers::Fast> object. + +That attribute coerces from ArrayRef and defaults to an empty L<HTTP::Headers::Fast> +instance. + +=head1 METHODS + +=head2 pass + +Set has_passed to true. + +=head2 serializer() + +Returns the optional serializer object used to deserialize request parameters + +=head2 halt + +Shortcut to halt the current response by setting the is_halted flag. + +=head2 encode_content + +Encodes the stored content according to the stored L<content_type>. If the content_type +is a text format C<^text>, then no encoding will take place. + +Internally, it uses the L<is_encoded> flag to make sure that content is not encoded twice. + +If it encodes the content, then it will return the encoded content. In all other +cases it returns C<false>. + +=head2 new_from_plack + +Creates a new response object from a L<Plack::Response> object. + +=head2 new_from_array + +Creates a new response object from a PSGI arrayref. + +=head2 to_psgi + +Converts the response object to a PSGI array. + +=head2 content_type($type) + +A little sugar for setting or accessing the content_type of the response, via the headers. + +=head2 redirect ($destination, $status) + +Sets a header in this response to give a redirect to $destination, and sets the +status to $status. If $status is omitted, or false, then it defaults to a status of +302. + +=head2 error( @args ) + + $response->error( message => "oops" ); + +Creates a L<Dancer2::Core::Error> object with the given I<@args> and I<throw()> +it against the response object. Returns the error object. + +=head2 serialize( $content ) + + $response->serialize( $content ); + +Serialize and return $content with the response's serializer. +set content-type accordingly. + +=head2 header($name) + +Return the value of the given header, if present. If the header has multiple +values, returns the list of values if called in list context, the first one +if in scalar context. + +=head2 push_header + +Add the header no matter if it already exists or not. + + $self->push_header( 'X-Wing' => '1' ); + +It can also be called with multiple values to add many times the same header +with different values: + + $self->push_header( 'X-Wing' => 1, 2, 3 ); + +=head2 headers_to_array($headers) + +Convert the C<$headers> to a PSGI ArrayRef. + +If no C<$headers> are provided, it will use the current response headers. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Response/Delayed.pm b/lib/Dancer2/Core/Response/Delayed.pm new file mode 100644 index 00000000..55dc5bd1 --- /dev/null +++ b/lib/Dancer2/Core/Response/Delayed.pm @@ -0,0 +1,175 @@ +package Dancer2::Core::Response::Delayed; +# ABSTRACT: Delayed responses +$Dancer2::Core::Response::Delayed::VERSION = '0.300000'; +use Moo; +use Dancer2::Core::Types qw<CodeRef InstanceOf>; + +has request => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Request'], + required => 1, +); + +has response => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Response'], + required => 1, + handles => [qw/status headers/], +); + +has cb => ( + is => 'ro', + isa => CodeRef, + required => 1, +); + +has error_cb => ( + is => 'ro', + isa => CodeRef, + predicate => '_has_error_cb', +); + +sub is_halted() {0} +sub has_passed() {0} + +sub to_psgi { + my $self = shift; + + return sub { + my $responder = shift; + + local $Dancer2::Core::Route::REQUEST = $self->request; + local $Dancer2::Core::Route::RESPONSE = $self->response; + local $Dancer2::Core::Route::RESPONDER = $responder; + local $Dancer2::Core::Route::WRITER; + + local $Dancer2::Core::Route::ERROR_HANDLER = + $self->_has_error_cb ? $self->error_cb : undef; + + $self->cb->(); + }; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Response::Delayed - Delayed responses + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + my $response = Dancer2::Core::Response::Delayed->new( + request => Dancer2::Core::Request->new(...), + response => Dancer2::Core::Response->new(...), + cb => sub {...}, + + # optional error handling + error_cb => sub { + my ($error) = @_; + ... + }, + ); + + # or in an app + get '/' => sub { + # delayed response: + delayed { + # streaming content + content "data"; + content "more data"; + + # close user connection + done; + } on_error => sub { + my ($error) = @_; + warning 'Failed to stream to user: ' . request->remote_address; + }; + }; + +=head1 DESCRIPTION + +This object represents a delayed (asynchronous) response for L<Dancer2>. +It can be used via the C<delayed> keyword. + +It keeps references to a request and a response in order to avoid +keeping a reference to the application. + +=head1 ATTRIBUTES + +=head2 request + +Contains a request the delayed response uses. + +In the context of a web request, this will be the request that existed +when the delayed response has been created. + +=head2 response + +Contains a response the delayed response uses. + +In the context of a web request, this will be the response that existed +when the delayed response has been created. + +=head2 cb + +The code that will be run asynchronously. + +=head2 error_cb + +A callback for handling errors. This callback receives the error as its +first (and currently only) parameter. + +=head1 METHODS + +=head2 is_halted + +A method indicating whether the response has halted. + +This is useless in the context of an asynchronous request so it simply +returns no. + +This method is likely going away. + +=head2 has_passed + +A method indicating whether the response asked to skip the current +response. + +This is useless in the context of an asynchronous request so it simply +returns no. + +This method is likely going away. + +=head2 to_psgi + +Create a PSGI response. The way it works is by returning a proper PSGI +response subroutine which localizes the request and response (in case +the callback wants to edit them without a reference to them), and then +calls the callback. + +Finally, when the callback is done, it asks the response (whether it +was changed or not) to create its own PSGI response (calling C<to_psgi>) +and sends that to the callback it receives as a delayed response. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/ConfigReader.pm b/lib/Dancer2/Core/Role/ConfigReader.pm new file mode 100644 index 00000000..83d58540 --- /dev/null +++ b/lib/Dancer2/Core/Role/ConfigReader.pm @@ -0,0 +1,357 @@ +# ABSTRACT: Config role for Dancer2 core objects +package Dancer2::Core::Role::ConfigReader; +$Dancer2::Core::Role::ConfigReader::VERSION = '0.300000'; +use Moo::Role; + +use File::Spec; +use Config::Any; +use Hash::Merge::Simple; +use Carp 'croak'; +use Module::Runtime 'require_module'; + +use Dancer2::Core::Factory; +use Dancer2::Core; +use Dancer2::Core::Types; +use Dancer2::FileUtils 'path'; + +with 'Dancer2::Core::Role::HasLocation'; + +has default_config => ( + is => 'ro', + isa => HashRef, + lazy => 1, + builder => '_build_default_config', +); + +has config_location => ( + is => 'ro', + isa => ReadableFilePath, + lazy => 1, + default => sub { $ENV{DANCER_CONFDIR} || $_[0]->location }, +); + +# The type for this attribute is Str because we don't require +# an existing directory with configuration files for the +# environments. An application without environments is still +# valid and works. +has environments_location => ( + is => 'ro', + isa => Str, + lazy => 1, + default => sub { + $ENV{DANCER_ENVDIR} + || File::Spec->catdir( $_[0]->config_location, 'environments' ) + || File::Spec->catdir( $_[0]->location, 'environments' ); + }, +); + +has config => ( + is => 'ro', + isa => HashRef, + lazy => 1, + builder => '_build_config', +); + +has environment => ( + is => 'ro', + isa => Str, + lazy => 1, + builder => '_build_environment', +); + +has config_files => ( + is => 'ro', + lazy => 1, + isa => ArrayRef, + builder => '_build_config_files', +); + +has local_triggers => ( + is => 'ro', + isa => HashRef, + default => sub { +{} }, +); + +has global_triggers => ( + is => 'ro', + isa => HashRef, + default => sub { + my $triggers = { + traces => sub { + my ( $self, $traces ) = @_; + # Carp is already a dependency + $Carp::Verbose = $traces ? 1 : 0; + }, + }; + + my $runner_config = defined $Dancer2::runner + ? Dancer2->runner->config + : {}; + + for my $global ( keys %$runner_config ) { + next if exists $triggers->{$global}; + $triggers->{$global} = sub { + my ($self, $value) = @_; + Dancer2->runner->config->{$global} = $value; + } + } + + return $triggers; + }, +); + +sub _build_default_config { +{} } + +sub _build_environment { 'development' } + +sub _build_config_files { + my ($self) = @_; + + my $location = $self->config_location; + # an undef location means no config files for the caller + return [] unless defined $location; + + my $running_env = $self->environment; + my @available_exts = Config::Any->extensions; + my @files; + + my @exts = @available_exts; + if (my $ext = $ENV{DANCER_CONFIG_EXT}) { + if (grep { $ext eq $_ } @available_exts) { + @exts = $ext; + warn "Only looking for configs ending in '$ext'\n" + if $ENV{DANCER_CONFIG_VERBOSE}; + } else { + warn "DANCER_CONFIG_EXT environment variable set to '$ext' which\n" . + "is not recognized by Config::Any. Looking for config file\n" . + "using default list of extensions:\n" . + "\t@available_exts\n"; + } + } + + foreach my $file ( [ $location, "config" ], + [ $self->environments_location, $running_env ] ) + { + foreach my $ext (@exts) { + my $path = path( $file->[0], $file->[1] . ".$ext" ); + next if !-r $path; + + # Look for *_local.ext files + my $local = path( $file->[0], $file->[1] . "_local.$ext" ); + push @files, $path, ( -r $local ? $local : () ); + } + } + + return \@files; +} + +sub _build_config { + my ($self) = @_; + + my $location = $self->config_location; + my $default = $self->default_config; + + my $config = Hash::Merge::Simple->merge( + $default, + map { + warn "Merging config file $_\n" if $ENV{DANCER_CONFIG_VERBOSE}; + $self->load_config_file($_) + } @{ $self->config_files } + ); + + $config = $self->_normalize_config($config); + return $config; +} + +sub _set_config_entries { + my ( $self, @args ) = @_; + my $no = scalar @args; + while (@args) { + $self->_set_config_entry( shift(@args), shift(@args) ); + } + return $no; +} + +sub _set_config_entry { + my ( $self, $name, $value ) = @_; + + $value = $self->_normalize_config_entry( $name, $value ); + $value = $self->_compile_config_entry( $name, $value, $self->config ); + $self->config->{$name} = $value; +} + +sub _normalize_config { + my ( $self, $config ) = @_; + + foreach my $key ( keys %{$config} ) { + my $value = $config->{$key}; + $config->{$key} = $self->_normalize_config_entry( $key, $value ); + } + return $config; +} + +sub _compile_config { + my ( $self, $config ) = @_; + + foreach my $key ( keys %{$config} ) { + my $value = $config->{$key}; + $config->{$key} = + $self->_compile_config_entry( $key, $value, $config ); + } + return $config; +} + +sub settings { shift->config } + +sub setting { + my $self = shift; + my @args = @_; + + return ( scalar @args == 1 ) + ? $self->settings->{ $args[0] } + : $self->_set_config_entries(@args); +} + +sub has_setting { + my ( $self, $name ) = @_; + return exists $self->config->{$name}; +} + +sub load_config_file { + my ( $self, $file ) = @_; + my $config; + + eval { + my @files = ($file); + my $tmpconfig = + Config::Any->load_files( { files => \@files, use_ext => 1 } )->[0]; + ( $file, $config ) = %{$tmpconfig} if defined $tmpconfig; + }; + if ( my $err = $@ || ( !$config ) ) { + croak "Unable to parse the configuration file: $file: $@"; + } + + # TODO handle mergeable entries + return $config; +} + +# private + +my $_normalizers = { + charset => sub { + my ($charset) = @_; + return $charset if !length( $charset || '' ); + + require_module('Encode'); + my $encoding = Encode::find_encoding($charset); + croak + "Charset defined in configuration is wrong : couldn't identify '$charset'" + unless defined $encoding; + my $name = $encoding->name; + + # Perl makes a distinction between the usual perl utf8, and the strict + # utf8 charset. But we don't want to make this distinction + $name = 'utf-8' if $name eq 'utf-8-strict'; + return $name; + }, +}; + +sub _normalize_config_entry { + my ( $self, $name, $value ) = @_; + $value = $_normalizers->{$name}->($value) + if exists $_normalizers->{$name}; + return $value; +} + +sub _compile_config_entry { + my ( $self, $name, $value, $config ) = @_; + + my $trigger = exists $self->local_triggers->{$name} ? + $self->local_triggers->{$name} : + $self->global_triggers->{$name}; + + defined $trigger or return $value; + + return $trigger->( $self, $value, $config ); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::ConfigReader - Config role for Dancer2 core objects + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Provides a C<config> attribute that feeds itself by finding and parsing +configuration files. + +Also provides a C<setting()> method which is supposed to be used by externals to +read/write config entries. + +=head1 ATTRIBUTES + +=head2 location + +Absolute path to the directory where the server started. + +=head2 config_location + +Gets the location from the configuration. Same as C<< $object->location >>. + +=head2 environments_location + +Gets the directory were the environment files are stored. + +=head2 config + +Returns the whole configuration. + +=head2 environments + +Returns the name of the environment. + +=head2 config_files + +List of all the configuration files. + +=head1 METHODS + +=head2 settings + +Alias for config. Equivalent to <<$object->config>>. + +=head2 setting + +Get or set an element from the configuration. + +=head2 has_setting + +Verifies that a key exists in the configuration. + +=head2 load_config_file + +Load the configuration files. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/DSL.pm b/lib/Dancer2/Core/Role/DSL.pm new file mode 100644 index 00000000..fc6de500 --- /dev/null +++ b/lib/Dancer2/Core/Role/DSL.pm @@ -0,0 +1,130 @@ +package Dancer2::Core::Role::DSL; +# ABSTRACT: Role for DSL +$Dancer2::Core::Role::DSL::VERSION = '0.300000'; +use Moo::Role; +use Dancer2::Core::Types; +use Carp 'croak'; +use Scalar::Util qw(); + +with 'Dancer2::Core::Role::Hookable'; + +has app => ( is => 'ro', required => 1 ); + +has keywords => ( + is => 'rw', + isa => HashRef, + lazy => 1, + builder => '_build_dsl_keywords', +); + +sub _build_dsl_keywords { + my ($self) = @_; + $self->can('dsl_keywords') + ? $self->dsl_keywords + : {}; +} + +sub register { + my ( $self, $keyword, $is_global ) = @_; + my $keywords = $self->keywords; + my $pkg = ref($self); + $pkg =~ s/__WITH__.+$//; + + if ( exists $keywords->{$keyword} ) { + my $reg_pkg = $keywords->{$keyword}{'pkg'}; + $reg_pkg =~ s/__WITH__.+$//; + $reg_pkg eq $pkg and return; + + croak "[$pkg] Keyword $keyword already registered by $reg_pkg"; + } + + $keywords->{$keyword} = { is_global => $is_global, pkg => $pkg }; +} + +sub dsl { $_[0] } + +# exports new symbol to caller +sub export_symbols_to { + my ( $self, $caller, $args ) = @_; + my $exports = $self->_construct_export_map($args); + + ## no critic + foreach my $export ( keys %{$exports} ) { + no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict) + my $existing = *{"${caller}::${export}"}{CODE}; + + next if defined $existing; + + *{"${caller}::${export}"} = $exports->{$export}; + } + ## use critic + + return keys %{$exports}; +} + +# private + +sub _compile_keyword { + my ( $self, $keyword, $opts ) = @_; + + my $code = $opts->{is_global} + ? sub { $self->$keyword(@_) } + : sub { + croak "Function '$keyword' must be called from a route handler" + unless defined $Dancer2::Core::Route::REQUEST; + + $self->$keyword(@_) + }; + + return $self->_apply_prototype($code, $opts); +} + +sub _apply_prototype { + my ($self, $code, $opts) = @_; + + # set prototype if one is defined for the keyword. undef => no prototype + my $prototype; + exists $opts->{'prototype'} and $prototype = $opts->{'prototype'}; + return Scalar::Util::set_prototype( \&$code, $prototype ); +} + +sub _construct_export_map { + my ( $self, $args ) = @_; + my $keywords = $self->keywords; + my %map; + foreach my $keyword ( keys %$keywords ) { + # check if the keyword were excluded from importation + $args->{ '!' . $keyword } and next; + $map{$keyword} = $self->_compile_keyword( $keyword, $keywords->{$keyword} ); + } + return \%map; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::DSL - Role for DSL + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/Engine.pm b/lib/Dancer2/Core/Role/Engine.pm new file mode 100644 index 00000000..affd66de --- /dev/null +++ b/lib/Dancer2/Core/Role/Engine.pm @@ -0,0 +1,71 @@ +package Dancer2::Core::Role::Engine; +# ABSTRACT: Role for engines +$Dancer2::Core::Role::Engine::VERSION = '0.300000'; +use Moo::Role; +use Dancer2::Core::Types; + +with 'Dancer2::Core::Role::Hookable'; + +has session => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Session'], + writer => 'set_session', + clearer => 'clear_session', + predicate => 'has_session', +); + +has config => ( + is => 'ro', + isa => HashRef, + default => sub { {} }, +); + +has request => ( + is => 'ro', + isa => InstanceOf['Dancer2::Core::Request'], + writer => 'set_request', + clearer => 'clear_request', + predicate => 'has_request', +); + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::Engine - Role for engines + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This role is intended to be consumed by all engine roles. It contains all the +shared logic for engines. + +This role consumes the L<Dancer2::Core::Role::Hookable> role. + +=head1 ATTRIBUTES + +=head2 config + +An HashRef that hosts the configuration bits for the engine. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/Handler.pm b/lib/Dancer2/Core/Role/Handler.pm new file mode 100644 index 00000000..1e55e92d --- /dev/null +++ b/lib/Dancer2/Core/Role/Handler.pm @@ -0,0 +1,52 @@ +package Dancer2::Core::Role::Handler; +# ABSTRACT: Role for Handlers +$Dancer2::Core::Role::Handler::VERSION = '0.300000'; +use Moo::Role; +use Dancer2::Core::Types; + +requires 'register'; + +has app => ( + is => 'ro', + isa => InstanceOf ['Dancer2::Core::App'], + weak_ref => 1, +); + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::Handler - Role for Handlers + +=head1 VERSION + +version 0.300000 + +=head1 ATTRIBUTES + +=head2 app + +Contain an object of class L<Dancer2::Core::App>. + +=head1 REQUIREMENTS + +This role requires the method C<register> to be implemented. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/HasLocation.pm b/lib/Dancer2/Core/Role/HasLocation.pm new file mode 100644 index 00000000..facb5c91 --- /dev/null +++ b/lib/Dancer2/Core/Role/HasLocation.pm @@ -0,0 +1,104 @@ +package Dancer2::Core::Role::HasLocation; +# ABSTRACT: Role for application location "guessing" +$Dancer2::Core::Role::HasLocation::VERSION = '0.300000'; +use Moo::Role; +use Dancer2::Core::Types; +use Dancer2::FileUtils; +use File::Spec; +use Sub::Quote 'quote_sub'; + +# the path to the caller script/app +# Note: to remove any ambiguity between the accessor for the +# 'caller' attribute and the core function caller(), explicitly +# specify we want the function 'CORE::caller' as the default for +# the attribute. +has caller => ( + is => 'ro', + isa => Str, + default => quote_sub( q{ + my ( $caller, $script ) = CORE::caller; + $script = File::Spec->abs2rel( $script ) if File::Spec->file_name_is_absolute( $script ); + $script; + } ), +); + +has location => ( + is => 'ro', + builder => '_build_location', +); + +# FIXME: i hate you most of all -- Sawyer X +sub _build_location { + my $self = shift; + my $script = $self->caller; + + # default to the dir that contains the script... + my $location = Dancer2::FileUtils::dirname($script); + + #we try to find bin and lib + my $subdir = $location; + my $subdir_found = 0; + + #maximum of 10 iterations, to prevent infinite loop + for ( 1 .. 10 ) { + + #try to find libdir and bindir to determine the root of dancer app + my $libdir = Dancer2::FileUtils::path( $subdir, 'lib' ); + my $bindir = Dancer2::FileUtils::path( $subdir, 'bin' ); + + #try to find .dancer_app file to determine the root of dancer app + my $dancerdir = Dancer2::FileUtils::path( $subdir, '.dancer' ); + + # if one of them is found, keep that; but skip ./blib since both lib and bin exist + # under it, but views and public do not. + if ( + ( $subdir !~ m![\\/]blib[\\/]?$! && -d $libdir && -d $bindir ) || + ( -f $dancerdir ) + ) { + $subdir_found = 1; + last; + } + + $subdir = Dancer2::FileUtils::path( $subdir, '..' ) || '.'; + last if File::Spec->rel2abs($subdir) eq File::Spec->rootdir; + + } + + my $path = $subdir_found ? $subdir : $location; + + # return if absolute + File::Spec->file_name_is_absolute($path) + and return $path; + + # convert relative to absolute + return File::Spec->rel2abs($path); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::HasLocation - Role for application location "guessing" + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/Hookable.pm b/lib/Dancer2/Core/Role/Hookable.pm new file mode 100644 index 00000000..cfe4bade --- /dev/null +++ b/lib/Dancer2/Core/Role/Hookable.pm @@ -0,0 +1,146 @@ +package Dancer2::Core::Role::Hookable; +# ABSTRACT: Role for hookable objects +$Dancer2::Core::Role::Hookable::VERSION = '0.300000'; +use Moo::Role; +use Dancer2::Core; +use Dancer2::Core::Types; +use Carp 'croak'; +use Safe::Isa; + +requires 'supported_hooks', 'hook_aliases'; + +# The hooks registry +has hooks => ( + is => 'ro', + isa => HashRef, + builder => '_build_hooks', + lazy => 1, +); + +sub BUILD { } + +# after a hookable object is built, we go over its postponed hooks and register +# them if any. +after BUILD => sub { + my ( $self, $args ) = @_; + $self->_add_postponed_hooks($args) + if defined $args->{postponed_hooks}; +}; + +sub _add_postponed_hooks { + my ( $self, $args ) = @_; + my $postponed_hooks = $args->{postponed_hooks}; + + # find the internal name of the hooks, from the caller name + my $caller = ref($self); + my ( $dancer, $h_type, $h_name, @rest ) = map lc, split /::/, $caller; + $h_name = $rest[0] if $h_name eq 'role'; + if ( $h_type =~ /(template|logger|serializer|session)/ ) { + $h_name = $h_type; + $h_type = 'engine'; + } + + # keep only the hooks we want + $postponed_hooks = $postponed_hooks->{$h_type}{$h_name}; + return unless defined $postponed_hooks; + + foreach my $name ( keys %{$postponed_hooks} ) { + my $hook = $postponed_hooks->{$name}{hook}; + my $caller = $postponed_hooks->{$name}{caller}; + + $self->has_hook($name) + or croak "$h_name $h_type does not support the hook `$name'. (" + . join( ", ", @{$caller} ) . ")"; + + $self->add_hook($hook); + } +} + +# mst++ for the hint +sub _build_hooks { + my ($self) = @_; + my %hooks = map +( $_ => [] ), $self->supported_hooks; + return \%hooks; +} + +# This binds a coderef to an installed hook if not already +# existing +sub add_hook { + my ( $self, $hook ) = @_; + my $name = $hook->name; + my $code = $hook->code; + + croak "Unsupported hook '$name'" + unless $self->has_hook($name); + + push @{ $self->hooks->{$name} }, $code; +} + +# allows the caller to replace the current list of hooks at the given position +# this is useful if the object where this role is composed wants to compile the +# hooks. +sub replace_hook { + my ( $self, $position, $hooks ) = @_; + + croak "Hook '$position' must be installed first" + unless $self->has_hook($position); + + $self->hooks->{$position} = $hooks; +} + +# Boolean flag to tells if the hook is registered or not +sub has_hook { + my ( $self, $hook_name ) = @_; + return exists $self->hooks->{$hook_name}; +} + +# Execute the hook at the given position +sub execute_hook { + my $self = shift; + my $name = shift; + + $name and !ref $name + or croak "execute_hook needs a hook name"; + + $name = $self->hook_aliases->{$name} + if exists $self->hook_aliases->{$name}; + + croak "Hook '$name' does not exist" + if !$self->has_hook($name); + + $self->$_isa('Dancer2::Core::App') && + $self->log( core => "Entering hook $name" ); + + for my $hook ( @{ $self->hooks->{$name} } ) { + $hook->(@_); + } +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::Hookable - Role for hookable objects + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/Logger.pm b/lib/Dancer2/Core/Role/Logger.pm new file mode 100644 index 00000000..25b81266 --- /dev/null +++ b/lib/Dancer2/Core/Role/Logger.pm @@ -0,0 +1,345 @@ +package Dancer2::Core::Role::Logger; +# ABSTRACT: Role for logger engines +$Dancer2::Core::Role::Logger::VERSION = '0.300000'; +use Dancer2::Core::Types; + +use Moo::Role; +use POSIX 'strftime'; +use Encode (); +use Data::Dumper; + +with 'Dancer2::Core::Role::Engine'; + +sub hook_aliases { +{} } +sub supported_hooks { + qw( + engine.logger.before + engine.logger.after + ); +} + +sub _build_type {'Logger'} + +# This is the only method to implement by logger engines. +# It receives the following arguments: +# $msg_level, $msg_content, it gets called only if the configuration allows +# a message of the given level to be logged. +requires 'log'; + +has auto_encoding_charset => ( + is => 'ro', + isa => Str, +); + +has app_name => ( + is => 'ro', + isa => Str, + default => sub {'-'}, +); + +has log_format => ( + is => 'rw', + isa => Str, + default => sub {'[%a:%P] %L @%T> %m in %f l. %l'}, +); + +my $_levels = { + + # levels < 0 are for core only + core => -10, + + # levels > 0 are for end-users only + debug => 1, + info => 2, + warn => 3, + warning => 3, + error => 4, +}; + +has log_level => ( + is => 'rw', + isa => Enum[keys %{$_levels}], + default => sub {'debug'}, +); + +sub _should { + my ( $self, $msg_level ) = @_; + my $conf_level = $self->log_level; + return $_levels->{$conf_level} <= $_levels->{$msg_level}; +} + +sub format_message { + my ( $self, $level, $message ) = @_; + chomp $message; + + $message = Encode::encode( $self->auto_encoding_charset, $message ) + if $self->auto_encoding_charset; + + my @stack = caller(8); + my $request = $self->request; + my $config = $self->config; + + my $block_handler = sub { + my ( $block, $type ) = @_; + if ( $type eq 't' ) { + return Encode::decode( + $config->{'charset'} || 'UTF-8', + POSIX::strftime( $block, localtime(time) ) + ); + } + elsif ( $type eq 'h' ) { + return ( $request && $request->header($block) ) || '-'; + } + else { + Carp::carp("{$block}$type not supported"); + return "-"; + } + }; + + my $chars_mapping = { + a => sub { $self->app_name }, + t => sub { + Encode::decode( + $config->{'charset'} || 'UTF-8', + POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime(time) ) + ); + }, + T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime(time) ) }, + u => sub { + Encode::decode( + $config->{'charset'} || 'UTF-8', + POSIX::strftime( "%d/%b/%Y %H:%M:%S", gmtime(time) ) + ); + }, + U => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", gmtime(time) ) }, + P => sub {$$}, + L => sub {$level}, + m => sub {$message}, + f => sub { $stack[1] || '-' }, + l => sub { $stack[2] || '-' }, + h => sub { + ( $request && ( $request->remote_host || $request->address ) ) || '-' + }, + i => sub { ( $request && $request->id ) || '-' }, + }; + + my $char_mapping = sub { + my $char = shift; + + my $cb = $chars_mapping->{$char}; + if ( !$cb ) { + Carp::carp "%$char not supported."; + return "-"; + } + $cb->($char); + }; + + my $fmt = $self->log_format; + + $fmt =~ s/ + (?: + \%\{(.+?)\}([a-z])| + \%([a-zA-Z]) + ) + / $1 ? $block_handler->($1, $2) : $char_mapping->($3) /egx; + + return $fmt . "\n"; +} + +sub _serialize { + my @vars = @_; + + return join q{}, map +( + ref $_ + ? Data::Dumper->new( [$_] )->Terse(1)->Purity(1)->Indent(0) + ->Sortkeys(1)->Dump() + : ( defined($_) ? $_ : 'undef' ) + ), @vars; +} + +around 'log' => sub { + my ($orig, $self, @args) = @_; + + $self->execute_hook( 'engine.logger.before', $self, @args ); + $self->$orig( @args ); + $self->execute_hook( 'engine.logger.after', $self, @args ); +}; + +sub core { + my ( $self, @args ) = @_; + $self->_should('core') and $self->log( 'core', _serialize(@args) ); +} + +sub debug { + my ( $self, @args ) = @_; + $self->_should('debug') and $self->log( 'debug', _serialize(@args) ); +} + +sub info { + my ( $self, @args ) = @_; + $self->_should('info') and $self->log( 'info', _serialize(@args) ); +} + +sub warning { + my ( $self, @args ) = @_; + $self->_should('warning') and $self->log( 'warning', _serialize(@args) ); +} + +sub error { + my ( $self, @args ) = @_; + $self->_should('error') and $self->log( 'error', _serialize(@args) ); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::Logger - Role for logger engines + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Any class that consumes this role will be able to implement to write log messages. + +In order to implement this role, the consumer B<must> implement the C<log> +method. This method will receives as argument the C<level> and the C<message>. + +=head1 ATTRIBUTES + +=head2 auto_encoding_charset + +Charset to use when writing a message. + +=head2 app_name + +Name of the application. Can be used in the message. + +=head2 log_format + +This is a format string (or a preset name) to specify the log format. + +The possible values are: + +=over 4 + +=item %h + +host emitting the request + +=item %t + +date (local timezone, formatted like %d/%b/%Y %H:%M:%S) + +=item %T + +date (local timezone, formatted like %Y-%m-%d %H:%M:%S) + +=item %u + +date (UTC timezone, formatted like %d/%b/%Y %H:%M:%S) + +=item %U + +date (UTC timezone, formatted like %Y-%m-%d %H:%M:%S) + +=item %P + +PID + +=item %L + +log level + +=item %D + +timer + +=item %m + +message + +=item %f + +file name that emit the message + +=item %l + +line from the file + +=item %i + +request ID + +=item %{$fmt}t + +timer formatted with a valid time format + +=item %{header}h + +header value + +=back + +=head2 log_level + +Level to use by default. + +=head1 METHODS + +=head2 core + +Log messages as B<core>. + +=head2 debug + +Log messages as B<debug>. + +=head2 info + +Log messages as B<info>. + +=head2 warning + +Log messages as B<warning>. + +=head2 error + +Log messages as B<error>. + +=head2 format_message + +Provides a common message formatting. + +=head1 CONFIGURATION + +The B<logger> configuration variable tells Dancer2 which engine to use. + +You can change it either in your config.yml file: + + # logging to console + logger: "console" + +The log format can also be configured, +please see L<Dancer2::Core::Role::Logger/"log_format"> for details. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/Serializer.pm b/lib/Dancer2/Core/Role/Serializer.pm new file mode 100644 index 00000000..49e78300 --- /dev/null +++ b/lib/Dancer2/Core/Role/Serializer.pm @@ -0,0 +1,165 @@ +package Dancer2::Core::Role::Serializer; +# ABSTRACT: Role for Serializer engines +$Dancer2::Core::Role::Serializer::VERSION = '0.300000'; +use Moo::Role; +use Dancer2::Core::Types; +use Scalar::Util 'blessed'; + +with 'Dancer2::Core::Role::Engine'; + +sub hook_aliases { + { + before_serializer => 'engine.serializer.before', + after_serializer => 'engine.serializer.after', + } +} + +sub supported_hooks { values %{ shift->hook_aliases } } + +sub _build_type {'Serializer'} + +requires 'serialize'; +requires 'deserialize'; + +has log_cb => ( + is => 'ro', + isa => CodeRef, + default => sub { sub {1} }, +); + +has content_type => ( + is => 'ro', + isa => Str, + required => 1, + writer => 'set_content_type' +); + +around serialize => sub { + my ( $orig, $self, $content, $options ) = @_; + + blessed $self && $self->execute_hook( 'engine.serializer.before', $content ); + + $content or return $content; + + my $data; + eval { + $data = $self->$orig( $content, $options ); + blessed $self + and $self->execute_hook( 'engine.serializer.after', $data ); + 1; + } or do { + my $error = $@ || 'Zombie Error'; + blessed $self + and $self->log_cb->( core => "Failed to serialize content: $error" ); + }; + + return $data; +}; + +around deserialize => sub { + my ( $orig, $self, $content, $options ) = @_; + + $content && length $content > 0 + or return $content; + + my $data; + eval { + $data = $self->$orig($content, $options); + 1; + } or do { + my $error = $@ || 'Zombie Error'; + $self->log_cb->( core => "Failed to deserialize content: $error" ); + }; + + return $data; +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::Serializer - Role for Serializer engines + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Any class that consumes this role will be able to be used as a +serializer under Dancer2. + +In order to implement this role, the consumer B<must> implement the +methods C<serialize> and C<deserialize>, and should define +the C<content_type> attribute value. + +=head1 ATTRIBUTES + +=head2 content_type + +The I<content type> of the object after being serialized. For example, +a JSON serializer would have a I<application/json> content type +defined. + +=head1 METHODS + +=head2 serialize($content, [\%options]) + +The serialize method need to be implemented by the consumer. It +receives the serializer class object and a reference to the object to +be serialized. Should return the object after being serialized, in the +content type defined by the C<content_type> attribute. + +A third optional argument is a hash reference of options to the +serializer. + +The serialize method must return bytes and therefore has to handle any +encoding. + +=head2 deserialize($content, [\%options]) + +The inverse method of C<serialize>. Receives the serializer class +object and a string that should be deserialized. The method should +return a reference to the deserialized Perl data structure. + +A third optional argument is a hash reference of options to the +serializer. + +The deserialize method receives encoded bytes and must therefore +handle any decoding required. + +=head1 CONFIGURATION + +The B<serializer> configuration variable tells Dancer2 which engine to use. + +You can change it either in your config.yml file: + + #Set JSON engine + serializer: "JSON" + + # Prettify JSON output + engines: + serializer: + JSON: + pretty: 1 + +To know which engines are availables please see L<Dancer2::Manual/"Serializers"> + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/SessionFactory.pm b/lib/Dancer2/Core/Role/SessionFactory.pm new file mode 100644 index 00000000..53c33157 --- /dev/null +++ b/lib/Dancer2/Core/Role/SessionFactory.pm @@ -0,0 +1,503 @@ +package Dancer2::Core::Role::SessionFactory; +# ABSTRACT: Role for session factories +$Dancer2::Core::Role::SessionFactory::VERSION = '0.300000'; +use Moo::Role; +with 'Dancer2::Core::Role::Engine'; + +use Carp 'croak'; +use Dancer2::Core::Session; +use Dancer2::Core::Types; +use Digest::SHA 'sha1'; +use List::Util 'shuffle'; +use MIME::Base64 'encode_base64url'; +use Module::Runtime 'require_module'; +use Ref::Util qw< is_ref is_arrayref is_hashref >; + +sub hook_aliases { +{} } +sub supported_hooks { + qw/ + engine.session.before_retrieve + engine.session.after_retrieve + + engine.session.before_create + engine.session.after_create + + engine.session.before_change_id + engine.session.after_change_id + + engine.session.before_destroy + engine.session.after_destroy + + engine.session.before_flush + engine.session.after_flush + /; +} + +sub _build_type { + 'SessionFactory'; +} # XXX vs 'Session'? Unused, so I can't tell -- xdg + +has log_cb => ( + is => 'ro', + isa => CodeRef, + default => sub { sub {1} }, +); + +has cookie_name => ( + is => 'ro', + isa => Str, + default => sub {'dancer.session'}, +); + +has cookie_domain => ( + is => 'ro', + isa => Str, + predicate => 1, +); + +has cookie_path => ( + is => 'ro', + isa => Str, + default => sub {"/"}, +); + +has cookie_duration => ( + is => 'ro', + isa => Str, + predicate => 1, +); + +has session_duration => ( + is => 'ro', + isa => Num, + predicate => 1, +); + +has is_secure => ( + is => 'rw', + isa => Bool, + default => sub {0}, +); + +has is_http_only => ( + is => 'rw', + isa => Bool, + default => sub {1}, +); + +sub create { + my ($self) = @_; + + my %args = ( id => $self->generate_id, ); + + $args{expires} = $self->cookie_duration + if $self->has_cookie_duration; + + my $session = Dancer2::Core::Session->new(%args); + + $self->execute_hook( 'engine.session.before_create', $session ); + + # XXX why do we _flush now? Seems unnecessary -- xdg, 2013-03-03 + eval { $self->_flush( $session->id, $session->data ) }; + croak "Unable to create a new session: $@" + if $@; + + $self->execute_hook( 'engine.session.after_create', $session ); + return $session; +} + +{ + my $COUNTER = 0; + my $CPRNG_AVAIL = eval { require_module('Math::Random::ISAAC::XS'); 1; } && + eval { require_module('Crypt::URandom'); 1; }; + + # don't initialize until generate_id is called so the ISAAC algorithm + # is seeded after any pre-forking + my $CPRNG; + + # prepend epoch seconds so session ID is roughly monotonic + sub generate_id { + my ($self) = @_; + + if ($CPRNG_AVAIL) { + $CPRNG ||= Math::Random::ISAAC::XS->new( + map { unpack( "N", Crypt::URandom::urandom(4) ) } 1 .. 256 ); + + # include $$ to ensure $CPRNG wasn't forked by accident + return encode_base64url( + pack( + "N6", + time, $$, $CPRNG->irand, + $CPRNG->irand, $CPRNG->irand, $CPRNG->irand + ) + ); + } + else { + my $seed = ( + rand(1_000_000_000) # a random number + . __FILE__ # the absolute path as a secret key + . $COUNTER++ # impossible to have two consecutive dups + . $$ # the process ID as another private constant + . "$self" # the instance's memory address for more entropy + . join( '', shuffle( 'a' .. 'z', 'A' .. 'Z', 0 .. 9 ) ) + + # a shuffled list of 62 chars, another random component + ); + return encode_base64url( pack( "Na*", time, sha1($seed) ) ); + } + + } +} + +sub validate_id { + my ($self, $id) = @_; + return $id =~ m/^[A-Za-z0-9_\-~]+$/; +} + +requires '_retrieve'; + +sub retrieve { + my ( $self, %params ) = @_; + my $id = $params{id}; + + $self->execute_hook( 'engine.session.before_retrieve', $id ); + + my $data; + # validate format of session id before attempt to retrieve + my $rc = eval { + $self->validate_id($id) && ( $data = $self->_retrieve($id) ); + }; + croak "Unable to retrieve session with id '$id'" + if ! $rc; + + my %args = ( id => $id, ); + + $args{data} = $data + if $data and is_hashref($data); + + $args{expires} = $self->cookie_duration + if $self->has_cookie_duration; + + my $session = Dancer2::Core::Session->new(%args); + + $self->execute_hook( 'engine.session.after_retrieve', $session ); + return $session; +} + +# XXX eventually we could perhaps require '_change_id'? + +sub change_id { + my ( $self, %params ) = @_; + my $session = $params{session}; + my $old_id = $session->id; + + $self->execute_hook( 'engine.session.before_change_id', $old_id ); + + my $new_id = $self->generate_id; + $session->id( $new_id ); + + eval { $self->_change_id( $old_id, $new_id ) }; + croak "Unable to change session id for session with id $old_id: $@" + if $@; + + $self->execute_hook( 'engine.session.after_change_id', $new_id ); +} + +requires '_destroy'; + +sub destroy { + my ( $self, %params ) = @_; + my $id = $params{id}; + $self->execute_hook( 'engine.session.before_destroy', $id ); + + eval { $self->_destroy($id) }; + croak "Unable to destroy session with id '$id': $@" + if $@; + + $self->execute_hook( 'engine.session.after_destroy', $id ); + return $id; +} + +requires '_flush'; + +sub flush { + my ( $self, %params ) = @_; + my $session = $params{session}; + $self->execute_hook( 'engine.session.before_flush', $session ); + + eval { $self->_flush( $session->id, $session->data ) }; + croak "Unable to flush session: $@" + if $@; + + $self->execute_hook( 'engine.session.after_flush', $session ); + return $session->id; +} + +sub set_cookie_header { + my ( $self, %params ) = @_; + $params{response}->push_header( + 'Set-Cookie', + $self->cookie( session => $params{session} )->to_header + ); +} + +sub cookie { + my ( $self, %params ) = @_; + my $session = $params{session}; + croak "cookie() requires a valid 'session' parameter" + unless is_ref($session) && $session->isa("Dancer2::Core::Session"); + + my %cookie = ( + value => $session->id, + name => $self->cookie_name, + path => $self->cookie_path, + secure => $self->is_secure, + http_only => $self->is_http_only, + ); + + $cookie{domain} = $self->cookie_domain + if $self->has_cookie_domain; + + if ( my $expires = $session->expires ) { + $cookie{expires} = $expires; + } + + return Dancer2::Core::Cookie->new(%cookie); +} + +requires '_sessions'; + +sub sessions { + my ($self) = @_; + my $sessions = $self->_sessions; + + croak "_sessions() should return an array ref" + unless is_arrayref($sessions); + + return $sessions; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::SessionFactory - Role for session factories + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Any class that consumes this role will be able to store, create, retrieve and +destroy session objects. + +The default values for attributes can be overridden in your Dancer2 +configuration. See L<Dancer2::Config/Session-engine>. + +=head1 ATTRIBUTES + +=head2 cookie_name + +The name of the cookie to create for storing the session key + +Defaults to C<dancer.session> + +=head2 cookie_domain + +The domain of the cookie to create for storing the session key. +Defaults to the empty string and is unused as a result. + +=head2 cookie_path + +The path of the cookie to create for storing the session key. +Defaults to "/". + +=head2 cookie_duration + +Default duration before session cookie expiration. If set, the +L<Dancer2::Core::Session> C<expires> attribute will be set to the current time +plus this duration (expression parsed by L<Dancer2::Core::Time>). + +=head2 session_duration + +Duration in seconds before sessions should expire, regardless of cookie +expiration. If set, then SessionFactories should use this to enforce a limit +on session validity. + +=head2 is_secure + +Boolean flag to tell if the session cookie is secure or not. + +Default is false. + +=head2 is_http_only + +Boolean flag to tell if the session cookie is http only. + +Default is true. + +=head1 INTERFACE + +Following is the interface provided by this role. When specified the required +methods to implement are described. + +=head2 create + +Create a brand new session object and store it. Returns the newly created +session object. + +Triggers an exception if the session is unable to be created. + + my $session = MySessionFactory->create(); + +This method does not need to be implemented in the class. + +=head2 generate_id + +Returns a randomly-generated, guaranteed-unique string. +By default, it is a 32-character, URL-safe, Base64 encoded combination +of a 32 bit timestamp and a 160 bit SHA1 digest of random seed data. +The timestamp ensures that session IDs are generally monotonic. + +The default algorithm is not guaranteed cryptographically secure, but it's +still reasonably strong for general use. + +If you have installed L<Math::Random::ISAAC::XS> and L<Crypt::URandom>, +the seed data will be generated from a cryptographically-strong +random number generator. + +This method is used internally by create() to set the session ID. + +This method does not need to be implemented in the class unless an +alternative method for session ID generation is desired. + +=head2 validate_id + +Returns true if a session id is of the correct format, or false otherwise. + +By default, this ensures that the session ID is a string of characters +from the Base64 schema for "URL Applications" plus the C<~> character. + +This method does not need to be implemented in the class unless an +alternative set of characters for session IDs is desired. + +=head2 retrieve + +Return the session object corresponding to the session ID given. If none is +found, triggers an exception. + + my $session = MySessionFactory->retrieve(id => $id); + +The method C<_retrieve> must be implemented. It must take C<$id> as a single +argument and must return a hash reference of session data. + +=head2 change_id + +Changes the session ID of the corresponding session. + + MySessionFactory->change_id(session => $session_object); + +The method C<_change_id> must be implemented. It must take C<$old_id> and +C<$new_id> as arguments and change the ID from the old one to the new one +in the underlying session storage. + +=head2 destroy + +Purges the session object that matches the ID given. Returns the ID of the +destroyed session if succeeded, triggers an exception otherwise. + + MySessionFactory->destroy(id => $id); + +The C<_destroy> method must be implemented. It must take C<$id> as a single +argument and destroy the underlying data. + +=head2 flush + +Make sure the session object is stored in the factory's backend. This method is +called to notify the backend about the change in the session object. + +The Dancer application will not call flush unless the session C<is_dirty> +attribute is true to avoid unnecessary writes to the database when no +data has been modified. + +An exception is triggered if the session is unable to be updated in the backend. + + MySessionFactory->flush(session => $session); + +The C<_flush> method must be implemented. It must take two arguments: the C<$id> +and a hash reference of session data. + +=head2 set_cookie_header + +Sets the session cookie into the response object + + MySessionFactory->set_cookie_header( + response => $response, + session => $session, + destroyed => undef, + ); + +The C<response> parameter contains a L<Dancer2::Core::Response> object. +The C<session> parameter contains a L<Dancer2::Core::Session> object. + +The C<destroyed> parameter is optional. If true, it indicates the +session was marked destroyed by the request context. The default +C<set_cookie_header> method doesn't need that information, but it is +included in case a SessionFactory must handle destroyed sessions +differently (such as signalling to middleware). + +=head2 cookie + +Coerce a session object into a L<Dancer2::Core::Cookie> object. + + MySessionFactory->cookie(session => $session); + +=head2 sessions + +Return a list of all session IDs stored in the backend. +Useful to create cleaning scripts, in conjunction with session's creation time. + +The C<_sessions> method must be implemented. It must return an array reference +of session IDs (or an empty array reference). + +=head1 CONFIGURATION + +If there are configuration values specific to your session factory in your config.yml or +environment, those will be passed to the constructor of the session factory automatically. +In order to accept and store them, you need to define accessors for them. + + engines: + session: + Example: + database_connection: "some_data" + +In your session factory: + + package Dancer2::Session::Example; + use Moo; + with "Dancer2::Core::Role::SessionFactory"; + + has database_connection => ( is => "ro" ); + +You need to do this for every configuration key. The ones that do not have accessors +defined will just go to the void. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/SessionFactory/File.pm b/lib/Dancer2/Core/Role/SessionFactory/File.pm new file mode 100644 index 00000000..dfab1a1d --- /dev/null +++ b/lib/Dancer2/Core/Role/SessionFactory/File.pm @@ -0,0 +1,189 @@ +package Dancer2::Core::Role::SessionFactory::File; +# ABSTRACT: Role for file-based session factories +$Dancer2::Core::Role::SessionFactory::File::VERSION = '0.300000'; +use Moo::Role; +with 'Dancer2::Core::Role::SessionFactory'; + +use Carp 'croak'; +use Dancer2::Core::Types; +use Dancer2::FileUtils qw(path set_file_mode escape_filename); +use Fcntl ':flock'; +use File::Copy (); + +#--------------------------------------------------------------------------# +# Required by classes consuming this role +#--------------------------------------------------------------------------# + +requires '_suffix'; # '.yml', '.json', etc. +requires '_thaw_from_handle'; # given handle, return session 'data' field +requires '_freeze_to_handle'; # given handle and data, serialize it + + +#--------------------------------------------------------------------------# +# Attributes and methods +#--------------------------------------------------------------------------# + +has session_dir => ( + is => 'ro', + isa => Str, + default => sub { path( '.', 'sessions' ) }, +); + +sub BUILD { + my $self = shift; + + if ( !-d $self->session_dir ) { + mkdir $self->session_dir + or croak "Unable to create session dir : " + . $self->session_dir . ' : ' + . $!; + } +} + +sub _sessions { + my ($self) = @_; + my $sessions = []; + + opendir( my $dh, $self->session_dir ) + or croak "Unable to open directory " . $self->session_dir . " : $!"; + + my $suffix = $self->_suffix; + + while ( my $file = readdir($dh) ) { + next if $file eq '.' || $file eq '..'; + if ( $file =~ /(\w+)\Q$suffix\E/ ) { + push @{$sessions}, $1; + } + } + closedir($dh); + + return $sessions; +} + +sub _retrieve { + my ( $self, $id ) = @_; + my $session_file = path( $self->session_dir, escape_filename($id) . $self->_suffix ); + + croak "Invalid session ID: $id" unless -f $session_file; + + open my $fh, '+<', $session_file or die "Can't open '$session_file': $!\n"; + flock $fh, LOCK_SH or die "Can't lock file '$session_file': $!\n"; + my $data = $self->_thaw_from_handle($fh); + close $fh or die "Can't close '$session_file': $!\n"; + + return $data; +} + +sub _change_id { + my ($self, $old_id, $new_id) = @_; + + my $old_path = + path($self->session_dir, escape_filename($old_id) . $self->_suffix); + + return if !-f $old_path; + + my $new_path = + path($self->session_dir, escape_filename($new_id) . $self->_suffix); + + File::Copy::move($old_path, $new_path); +} + +sub _destroy { + my ( $self, $id ) = @_; + my $session_file = path( $self->session_dir, escape_filename($id) . $self->_suffix ); + return if !-f $session_file; + + unlink $session_file; +} + +sub _flush { + my ( $self, $id, $data ) = @_; + my $session_file = path( $self->session_dir, escape_filename($id) . $self->_suffix ); + + open my $fh, '>', $session_file or die "Can't open '$session_file': $!\n"; + flock $fh, LOCK_EX or die "Can't lock file '$session_file': $!\n"; + seek $fh, 0, 0 or die "Can't seek in file '$session_file': $!\n"; + truncate $fh, 0 or die "Can't truncate file '$session_file': $!\n"; + set_file_mode($fh); + $self->_freeze_to_handle( $fh, $data ); + close $fh or die "Can't close '$session_file': $!\n"; + + return $data; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::SessionFactory::File - Role for file-based session factories + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This is a specialized SessionFactory role for storing session +data in files. + +This role manages the files. Classes consuming it only need to handle +serialization and deserialization. + +Classes consuming this must satisfy three requirements: C<_suffix>, +C<_freeze_to_handle> and C<_thaw_from_handle>. + + package Dancer2::SessionFactory::XYX + + use Moo; + + has _suffix => ( + is => 'ro', + isa => 'Str', + default => sub { '.xyz' }, + ); + + with 'Dancer2::Core::Role::SessionFactory::File'; + + sub _freeze_to_handle { + my ($self, $fh, $data) = @_; + + # ... do whatever to get data into $fh + + return; + } + + sub _thaw_from_handle { + my ($self, $fh) = @_; + my $data; + + # ... do whatever to get data from $fh + + return $data; + } + + 1; + +=head1 ATTRIBUTES + +=head2 session_dir + +Where to store the session files. Defaults to "./sessions". + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/StandardResponses.pm b/lib/Dancer2/Core/Role/StandardResponses.pm new file mode 100644 index 00000000..ad9efa3a --- /dev/null +++ b/lib/Dancer2/Core/Role/StandardResponses.pm @@ -0,0 +1,70 @@ +package Dancer2::Core::Role::StandardResponses; +# ABSTRACT: Role to provide commonly used responses +$Dancer2::Core::Role::StandardResponses::VERSION = '0.300000'; +use Moo::Role; +use Dancer2::Core::HTTP; + +sub response { + my ( $self, $app, $code, $message ) = @_; + $app->response->status($code); + $app->response->header( 'Content-Type', 'text/plain' ); + return $message; +} + +sub standard_response { + my ( $self, $app, $status_code ) = @_; + + return $self->response( + $app, + $status_code, + Dancer2::Core::HTTP->status_message($status_code), + ); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::StandardResponses - Role to provide commonly used responses + +=head1 VERSION + +version 0.300000 + +=head1 METHODS + +=head2 response + +Generic method that produces a custom response given with a code and a message: + + $self->response( $app, 404, 'Not Found' ); + +This could be used to create your own, which is separate from the standard one: + + $self->response( $app, 404, 'File missing in action' ); + +=head2 standard_response + +Produces a standard response using the code. + + # first example can be more easily written as + $self->standard_response( $app, 404 ); + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Role/Template.pm b/lib/Dancer2/Core/Role/Template.pm new file mode 100644 index 00000000..0d8a86c5 --- /dev/null +++ b/lib/Dancer2/Core/Role/Template.pm @@ -0,0 +1,367 @@ +# ABSTRACT: Role for template engines + +package Dancer2::Core::Role::Template; +$Dancer2::Core::Role::Template::VERSION = '0.300000'; +use Dancer2::Core::Types; +use Dancer2::FileUtils 'path'; +use Carp 'croak'; +use Ref::Util qw< is_ref >; + +use Moo::Role; +with 'Dancer2::Core::Role::Engine'; + +sub hook_aliases { + { + before_template_render => 'engine.template.before_render', + after_template_render => 'engine.template.after_render', + before_layout_render => 'engine.template.before_layout_render', + after_layout_render => 'engine.template.after_layout_render', + } +} + +sub supported_hooks { values %{ shift->hook_aliases } } + +sub _build_type {'Template'} + +requires 'render'; + +has log_cb => ( + is => 'ro', + isa => CodeRef, + default => sub { sub {1} }, +); + +has name => ( + is => 'ro', + lazy => 1, + builder => 1, +); + +sub _build_name { + ( my $name = ref shift ) =~ s/^Dancer2::Template:://; + $name; +} + +has charset => ( + is => 'ro', + isa => Str, + default => sub {'UTF-8'}, +); + +has default_tmpl_ext => ( + is => 'ro', + isa => Str, + default => sub { shift->config->{extension} || 'tt' }, +); + +has engine => ( + is => 'ro', + isa => Object, + lazy => 1, + builder => 1, +); + +has settings => ( + is => 'ro', + isa => HashRef, + lazy => 1, + default => sub { +{} }, + writer => 'set_settings', +); + +# The attributes views, layout and layout_dir have triggers in +# Dancer2::Core::App that enable their values to be modified by +# the `set` keyword. As such, these are defined as read-write attrs. + +has views => ( + is => 'rw', + isa => Maybe [Str], +); + +has layout => ( + is => 'rw', + isa => Maybe [Str], +); + +has layout_dir => ( + is => 'rw', + isa => Maybe [Str], +); + +sub _template_name { + my ( $self, $view ) = @_; + my $def_tmpl_ext = $self->default_tmpl_ext(); + $view .= ".$def_tmpl_ext" if $view !~ /\.\Q$def_tmpl_ext\E$/; + return $view; +} + +sub view_pathname { + my ( $self, $view ) = @_; + + $view = $self->_template_name($view); + return path( $self->views, $view ); +} + +sub layout_pathname { + my ( $self, $layout ) = @_; + + return path( + $self->views, + $self->layout_dir, + $self->_template_name($layout), + ); +} + +sub pathname_exists { + my ( $self, $pathname ) = @_; + return -f $pathname; +} + +sub render_layout { + my ( $self, $layout, $tokens, $content ) = @_; + + $layout = $self->layout_pathname($layout); + + # FIXME: not sure if I can "just call render" + $self->render( $layout, { %$tokens, content => $content } ); +} + +sub apply_renderer { + my ( $self, $view, $tokens ) = @_; + $view = $self->view_pathname($view) if !is_ref($view); + $tokens = $self->_prepare_tokens_options( $tokens ); + + $self->execute_hook( 'engine.template.before_render', $tokens ); + + my $content = $self->render( $view, $tokens ); + $self->execute_hook( 'engine.template.after_render', \$content ); + + # make sure to avoid ( undef ) in list context return + defined $content and return $content; + return; +} + +sub apply_layout { + my ( $self, $content, $tokens, $options ) = @_; + + $tokens = $self->_prepare_tokens_options( $tokens ); + + # If 'layout' was given in the options hashref, use it if it's a true value, + # or don't use a layout if it was false (0, or undef); if layout wasn't + # given in the options hashref, go with whatever the current layout setting + # is. + my $layout = + exists $options->{layout} + ? ( $options->{layout} ? $options->{layout} : undef ) + : ( $self->layout || $self->config->{layout} ); + + # that should only be $self->config, but the layout ain't there ??? + + defined $content or return; + defined $layout or return $content; + + $self->execute_hook( + 'engine.template.before_layout_render', + $tokens, \$content + ); + + my $full_content = $self->render_layout( $layout, $tokens, $content ); + + $self->execute_hook( 'engine.template.after_layout_render', + \$full_content ); + + # make sure to avoid ( undef ) in list context return + defined $full_content and return $full_content; + return; +} + +sub _prepare_tokens_options { + my ( $self, $tokens ) = @_; + + # these are the default tokens provided for template processing + $tokens ||= {}; + $tokens->{perl_version} = $^V; + $tokens->{dancer_version} = Dancer2->VERSION; + $tokens->{settings} = $self->settings; + + # no request when template is called as a global keyword + if ( $self->has_request ) { + $tokens->{request} = $self->request; + $tokens->{params} = $self->request->params; + $tokens->{vars} = $self->request->vars; + + # a session can not exist if there is no request + $tokens->{session} = $self->session->data + if $self->has_session; + } + + return $tokens; +} + +sub process { + my ( $self, $view, $tokens, $options ) = @_; + my ( $content, $full_content ); + + # it's important that $tokens is not undef, so that things added to it via + # a before_template in apply_renderer survive to the apply_layout. GH#354 + $tokens ||= {}; + $options ||= {}; + + ## FIXME - Look into PR 654 so we fix the problem here as well! + + $content = + $view + ? $self->apply_renderer( $view, $tokens ) + : delete $options->{content}; + + defined $content + and $full_content = $self->apply_layout( $content, $tokens, $options ); + + defined $full_content + and return $full_content; + + croak "Template did not produce any content"; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Role::Template - Role for template engines + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Any class that consumes this role will be able to be used as a template engine +under Dancer2. + +In order to implement this role, the consumer B<must> implement the method C<render>. This method will receive three arguments: + +=over 4 + +=item $self + +=item $template + +=item $tokens + +=back + +Any template receives the following tokens, by default: + +=over 4 + +=item * C<perl_version> + +Current version of perl, effectively C<$^V>. + +=item * C<dancer_version> + +Current version of Dancer2, effectively C<< Dancer2->VERSION >>. + +=item * C<settings> + +A hash of the application configuration. + +=item * C<request> + +The current request object. + +=item * C<params> + +A hash reference of all the parameters. + +Currently the equivalent of C<< $request->params >>. + +=item * C<vars> + +The list of request variables, which is what you would get if you +called the C<vars> keyword. + +=item * C<session> + +The current session data, if a session exists. + +=back + +=head1 ATTRIBUTES + +=head2 name + +The name of the template engine (e.g.: Simple). + +=head2 charset + +The charset. The default value is B<UTF-8>. + +=head2 default_tmpl_ext + +The default file extension. If not provided, B<tt> is used. + +=head2 views + +Path to the directory containing the views. + +=head2 layout + +Path to the directory containing the layouts. + +=head2 layout_dir + +Relative path to the layout directory. + +Default: B<layouts>. + +=head2 engine + +Contains the engine. + +=head1 METHODS + +=head2 view_pathname($view) + +Returns the full path to the requested view. + +=head2 layout_pathname($layout) + +Returns the full path to the requested layout. + +=head2 pathname_exists($pathname) + +Returns true if the requested pathname exists. Can be used for either views +or layouts: + + $self->pathname_exists( $self->view_pathname( 'some_view' ) ); + $self->pathname_exists( $self->layout_pathname( 'some_layout' ) ); + +=head2 render_layout($layout, \%tokens, \$content) + +Render the layout with the applied tokens + +=head2 apply_renderer($view, \%tokens) + +=head2 apply_layout($content, \%tokens, \%options) + +=head2 process($view, \%tokens, \%options) + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Route.pm b/lib/Dancer2/Core/Route.pm new file mode 100644 index 00000000..388bb0e1 --- /dev/null +++ b/lib/Dancer2/Core/Route.pm @@ -0,0 +1,373 @@ +package Dancer2::Core::Route; +# ABSTRACT: Dancer2's route handler +$Dancer2::Core::Route::VERSION = '0.300000'; +use Moo; +use Dancer2::Core::Types; +use Module::Runtime 'use_module'; +use Carp 'croak'; +use List::Util 'first'; +use Scalar::Util 'blessed'; +use Ref::Util qw< is_regexpref >; +use Type::Registry; + +our ( $REQUEST, $RESPONSE, $RESPONDER, $WRITER, $ERROR_HANDLER ); + +has method => ( + is => 'ro', + isa => Dancer2Method, + required => 1, +); + +has code => ( + is => 'ro', + required => 1, + isa => CodeRef, +); + +has regexp => ( + is => 'ro', + required => 1, +); + +has spec_route => ( is => 'ro' ); + +has prefix => ( + is => 'ro', + isa => Maybe [Dancer2Prefix], + predicate => 1, +); + +has options => ( + is => 'ro', + isa => HashRef, + trigger => \&_check_options, + predicate => 1, +); + +sub _check_options { + my ( $self, $options ) = @_; + return 1 unless defined $options; + + my @supported_options = ( + qw/content_type agent user_agent content_length + path_info/ + ); + for my $opt ( keys %{$options} ) { + croak "Not a valid option for route matching: `$opt'" + if not( grep {/^$opt$/} @supported_options ); + } + return 1; +} + +# private attributes + +has _should_capture => ( + is => 'ro', + isa => Bool, +); + +has _match_data => ( + is => 'rw', + isa => HashRef, +); + +has _params => ( + is => 'ro', + isa => ArrayRef, + default => sub { [] }, +); + +has _typed_params => ( + is => 'ro', + isa => ArrayRef, + default => sub { [] }, +); + +sub match { + my ( $self, $request ) = @_; + + if ( $self->has_options ) { + return unless $self->validate_options($request); + } + + my @values = $request->path =~ $self->regexp; + + return unless @values; + + # if some named captures are found, return captures + # no warnings is for perl < 5.10 + # - Note no @values implies no named captures + if (my %captures = + do { no warnings; %+ } + ) + { + return $self->_match_data( { captures => \%captures } ); + } + + # regex comments are how we know if we captured a token, + # splat or a megasplat + my @token_or_splat = + $self->regexp =~ /\(\?#((?:typed_)?token|(?:mega)?splat)\)/g; + + if (@token_or_splat) { + # our named tokens + my @tokens = @{ $self->_params }; + my @typed_tokens = @{ $self->_typed_params }; + + my %params; + my @splat; + for ( my $i = 0; $i < @values; $i++ ) { + # Is this value from a token? + if ( $token_or_splat[$i] eq 'typed_token' ) { + my ( $token, $type ) = @{ shift @typed_tokens }; + + if (defined $values[$i]) { + # undef value mean that token was marked as optional so + # we only do type check on defined value + return + unless $type->check($values[$i]); + } + $params{$token} = $values[$i]; + next; + } + if ( $token_or_splat[$i] eq 'token' ) { + $params{ shift @tokens } = $values[$i]; + next; + } + + # megasplat values are split on '/' + if ($token_or_splat[$i] eq 'megasplat') { + $values[$i] = [ + defined $values[$i] ? split( m{/} , $values[$i], -1 ) : () + ]; + } + push @splat, $values[$i]; + } + return $self->_match_data( { + %params, + (splat => \@splat)x!! @splat, + }); + } + + if ( $self->_should_capture ) { + return $self->_match_data( { splat => \@values } ); + } + + return $self->_match_data( {} ); +} + +sub execute { + my ( $self, $app, @args ) = @_; + local $REQUEST = $app->request; + local $RESPONSE = $app->response; + + my $content = $self->code->( $app, @args ); + + # users may set content in the response. If the response has + # content, and the returned value from the route code is not + # an object (well, reference) we ignore the returned value + # and use the existing content in the response instead. + $RESPONSE->has_content && !ref $content + and return $app->_prep_response( $RESPONSE ); + + my $type = blessed($content) + or return $app->_prep_response( $RESPONSE, $content ); + + # Plack::Response: proper ArrayRef-style response + $type eq 'Plack::Response' + and $RESPONSE = Dancer2::Core::Response->new_from_plack($RESPONSE); + + # CodeRef: raw PSGI response + # do we want to allow it and forward it back? + # do we want to upgrade it to an asynchronous response? + $type eq 'CODE' + and die "We do not support returning code references from routes.\n"; + + # Dancer2::Core::Response, Dancer2::Core::Response::Delayed: + # proper responses + $type eq 'Dancer2::Core::Response' + and return $RESPONSE; + + $type eq 'Dancer2::Core::Response::Delayed' + and return $content; + + # we can't handle arrayref or hashref + # because those might be serialized back + die "Unrecognized response type from route: $type.\n"; +} + +# private subs + +sub BUILDARGS { + my ( $class, %args ) = @_; + + my $prefix = $args{prefix}; + my $regexp = $args{regexp}; + + my $type_library = delete $args{type_library}; + if ( $type_library) { + eval { use_module($type_library); 1 } + or croak "type_library $type_library cannot be loaded"; + } + $type_library ||= 'Dancer2::Core::Types'; + + # init prefix + if ( $prefix ) { + $args{regexp} = + is_regexpref($regexp) ? qr{^\Q${prefix}\E${regexp}$} : + $prefix . $regexp; + } + elsif ( !is_regexpref($regexp) ) { + # No prefix, so ensure regexp begins with a '/' + index( $regexp, '/', 0 ) == 0 or $args{regexp} = "/$regexp"; + } + + # init regexp + $regexp = $args{regexp}; # updated value + $args{spec_route} = $regexp; + + if ( is_regexpref($regexp)) { + $args{_should_capture} = 1; + } + else { + @args{qw/ regexp _params _typed_params _should_capture/} = + @{ _build_regexp_from_string($regexp, $type_library) }; + } + + return \%args; +} + +sub _build_regexp_from_string { + my ($string, $type_library) = @_; + + my $capture = 0; + my ( @params, @typed_params ); + + my $type_registry = Type::Registry->new; + $type_registry->add_types($type_library); + + # look for route with tokens [aka params] (/hello/:foo) + if ( $string =~ /:/ ) { + my @found = $string =~ m|:([^/.\?]+)|g; + foreach my $token ( @found ) { + if ( $token =~ s/\[(.+)\]$// ) { + + # typed token + my $type = $type_registry->lookup($1); + push @typed_params, [ $token, $type ]; + } + else { + push @params, $token; + } + } + if (@typed_params) { + $string =~ s!(:[^/.\?]+\[[^/.\?]+\])!(?#typed_token)([^/]+)!g; + $capture = 1; + } + if (@params) { + first { $_ eq 'splat' } @params + and warn q{Named placeholder 'splat' is deprecated}; + + first { $_ eq 'captures' } @params + and warn q{Named placeholder 'captures' is deprecated}; + + $string =~ s!(:[^\/\.\?]+)!(?#token)([^/]+)!g; + $capture = 1; + } + } + + # parse megasplat + # we use {0,} instead of '*' not to fall in the splat rule + # same logic for [^\n] instead of '.' + $capture = 1 if $string =~ s!\Q**\E!(?#megasplat)([^\n]+)!g; + + # parse wildcards + $capture = 1 if $string =~ s!\*!(?#splat)([^/]+)!g; + + # escape dots + $string =~ s/\./\\\./g if $string =~ /\./; + + # escape slashes + $string =~ s/\//\\\//g; + + return [ "^$string\$", \@params, \@typed_params, $capture ]; +} + +sub validate_options { + my ( $self, $request ) = @_; + + for my $option ( keys %{ $self->options } ) { + return 0 + if ( + ( not $request->$option ) + || ( $request->$option !~ $self->options->{ $option } ) + ) + } + return 1; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Route - Dancer2's route handler + +=head1 VERSION + +version 0.300000 + +=head1 ATTRIBUTES + +=head2 method + +The HTTP method of the route (lowercase). Required. + +=head2 code + +The code reference to execute when the route is ran. Required. + +=head2 regexp + +The regular expression that defines the path of the route. +Required. Coerce from Dancer2's route I<patterns>. + +=head2 prefix + +The prefix to prepend to the C<regexp>. Optional. + +=head2 options + +A HashRef of conditions on which the matching will depend. Optional. + +=head1 METHODS + +=head2 match + +Try to match the route with a given L<Dancer2::Core::Request> object. +Returns the hash of matching data if success (captures and values of the route +against the path of the request) or C<undef> if not. + + my $match = $route->match( $request ); + +=head2 execute + +Runs the coderef of the route. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Runner.pm b/lib/Dancer2/Core/Runner.pm new file mode 100644 index 00000000..9f310040 --- /dev/null +++ b/lib/Dancer2/Core/Runner.pm @@ -0,0 +1,277 @@ +package Dancer2::Core::Runner; +# ABSTRACT: Top-layer class to start a dancer app +$Dancer2::Core::Runner::VERSION = '0.300000'; +use Moo; +use Carp 'croak'; +use Module::Runtime 'require_module'; +use Dancer2::Core::MIME; +use Dancer2::Core::Types; +use Dancer2::Core::Dispatcher; +use Plack::Builder qw(); +use Ref::Util qw< is_ref is_regexpref >; + +# Hashref of configurable items for the runner. +# Defaults come from ENV vars. Updated via global triggers +# from app configs. +has config => ( + is => 'ro', + isa => HashRef, + lazy => 1, + builder => '_build_config', +); + +# FIXME: i hate this +has mime_type => ( + is => 'ro', + isa => InstanceOf ['Dancer2::Core::MIME'], + default => sub { Dancer2::Core::MIME->new(); }, +); + +has server => ( + is => 'ro', + isa => InstanceOf['HTTP::Server::PSGI'], + lazy => 1, + builder => '_build_server', + handles => ['run'], +); + +has apps => ( + is => 'ro', + isa => ArrayRef, + default => sub { [] }, +); + +has postponed_hooks => ( + is => 'ro', + isa => HashRef, + default => sub { +{} }, +); + +has environment => ( + is => 'ro', + isa => Str, + required => 1, + default => sub { + $ENV{DANCER_ENVIRONMENT} || $ENV{PLACK_ENV} || 'development' + }, +); + +has host => ( + is => 'ro', + lazy => 1, + default => sub { $_[0]->config->{'host'} }, +); + +has port => ( + is => 'ro', + lazy => 1, + default => sub { $_[0]->config->{'port'} }, +); + +has timeout => ( + is => 'ro', + lazy => 1, + default => sub { $_[0]->config->{'timeout'} }, +); + +sub _build_server { + my $self = shift; + + require_module('HTTP::Server::PSGI'); + HTTP::Server::PSGI->new( + host => $self->host, + port => $self->port, + timeout => $self->timeout, + server_software => "Perl Dancer2 " . Dancer2->VERSION, + ); +} + +sub _build_config { + my $self = shift; + + $ENV{PLACK_ENV} + and $ENV{DANCER_APPHANDLER} = 'PSGI'; + + return { + behind_proxy => 0, + apphandler => ( $ENV{DANCER_APPHANDLER} || 'Standalone' ), + traces => ( $ENV{DANCER_TRACES} || 0 ), + host => ( $ENV{DANCER_SERVER} || '0.0.0.0' ), + port => ( $ENV{DANCER_PORT} || '3000' ), + no_server_tokens => ( defined $ENV{DANCER_NO_SERVER_TOKENS} ? + $ENV{DANCER_NO_SERVER_TOKENS} : + 0 ), + startup_info => ( defined $ENV{DANCER_STARTUP_INFO} ? + $ENV{DANCER_STARTUP_INFO} : + 1 ), + }; +} + +sub BUILD { + my $self = shift; + + # Enable traces if set by ENV var. + if (my $traces = $self->config->{traces} ) { + require_module('Carp'); + $Carp::Verbose = $traces ? 1 : 0; + }; + + # set the global runner object if one doesn't exist yet + # this can happen if you create one without going through Dancer2 + # which doesn't trigger the import that creates it + defined $Dancer2::runner + or $Dancer2::runner = $self; +} + +sub register_application { + my $self = shift; + my $app = shift; + + push @{ $self->apps }, $app; + + # add postponed hooks to our psgi app + $self->add_postponed_hooks( $app->name, $app->postponed_hooks ); +} + +sub add_postponed_hooks { + my $self = shift; + my $name = shift; + my $hooks = shift; + + # merge postponed hooks + @{ $self->{'postponed_hooks'}{$name} }{ keys %{$hooks} } = values %{$hooks}; +} + +# decide what to start +# do we just return a PSGI app +# or do we actually start a development standalone server? +sub start { + my $self = shift; + my $app = $self->psgi_app; + + # we decide whether we return a PSGI coderef + # or spin a local development PSGI server + $self->config->{'apphandler'} eq 'PSGI' + and return $app; + + # FIXME: this should not include the server tokens + # since those are already added to the server itself + $self->start_server($app); +} + +sub start_server { + my $self = shift; + my $app = shift; + + # does not return + $self->print_banner; + $self->server->run($app); +} + +sub psgi_app { + my ($self, $apps) = @_; + + if ( $apps && @{$apps} ) { + my @found_apps = (); + + foreach my $app_req ( @{$apps} ) { + if ( is_regexpref($app_req) ) { + # find it in the apps registry + push @found_apps, + grep +( $_->name =~ $app_req ), @{ $self->apps }; + } elsif ( ref $app_req eq 'Dancer2::Core::App' ) { + # use it directly + push @found_apps, $app_req; + } elsif ( !is_ref($app_req) ) { + # find it in the apps registry + push @found_apps, + grep +( $_->name eq $app_req ), @{ $self->apps }; + } else { + croak "Invalid input to psgi_app: $app_req"; + } + } + + $apps = \@found_apps; + } else { + # dispatch over all apps by default + $apps = $self->apps; + } + + my $dispatcher = Dancer2::Core::Dispatcher->new( apps => $apps ); + + # initialize psgi_apps + # (calls ->finish on the apps and create their PSGI apps) + # the dispatcher caches that in the attribute + # so ->finish isn't actually called again if you run this method + $dispatcher->apps_psgi; + + return sub { + my $env = shift; + + # mark it as an old-style dispatching + $self->{'internal_dispatch'} = 1; + + my $response = $dispatcher->dispatch($env); + + # unmark it + delete $self->{'internal_dispatch'}; + + # cleanup + delete $self->{'internal_sessions'}; + + return $response; + }; +} + +sub print_banner { + my $self = shift; + my $pid = $$; + + # we only print the info if we need to + $self->config->{'startup_info'} or return; + + # bare minimum + print STDERR ">> Dancer2 v" . Dancer2->VERSION . " server $pid listening " + . 'on http://' + . $self->host . ':' + . $self->port . "\n"; + + # all loaded plugins + foreach my $module ( grep { $_ =~ m{^Dancer2/Plugin/} } keys %INC ) { + $module =~ s{/}{::}g; # change / to :: + $module =~ s{\.pm$}{}; # remove .pm at the end + my $version = $module->VERSION; + + defined $version or $version = 'no version number defined'; + print STDERR ">> $module ($version)\n"; + } +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Runner - Top-layer class to start a dancer app + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Session.pm b/lib/Dancer2/Core/Session.pm new file mode 100644 index 00000000..64a24b01 --- /dev/null +++ b/lib/Dancer2/Core/Session.pm @@ -0,0 +1,153 @@ +package Dancer2::Core::Session; +# ABSTRACT: class to represent any session object +$Dancer2::Core::Session::VERSION = '0.300000'; +use Moo; +use Dancer2::Core::Types; +use Dancer2::Core::Time; + +has id => ( + # for some specific plugins this should be rw. + # refer to https://github.com/PerlDancer/Dancer2/issues/460 + is => 'rw', + isa => Str, + required => 1, +); + +has data => ( + is => 'ro', + lazy => 1, + default => sub { {} }, +); + +has expires => ( + is => 'rw', + isa => Str, + coerce => sub { + my $value = shift; + $value += time if $value =~ /^[\-\+]?\d+$/; + Dancer2::Core::Time->new( expression => $value )->epoch; + }, +); + +has is_dirty => ( + is => 'rw', + isa => Bool, + default => sub {0}, +); + + +sub read { + my ( $self, $key ) = @_; + return $self->data->{$key}; +} + + +sub write { + my ( $self, $key, $value ) = @_; + $self->is_dirty(1); + $self->data->{$key} = $value; +} + +sub delete { + my ( $self, $key, $value ) = @_; + $self->is_dirty(1); + delete $self->data->{$key}; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Session - class to represent any session object + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +A session object encapsulates anything related to a specific session: its ID, +its data, and its expiration. + +It is completely agnostic of how it will be stored, this is the role of +a factory that consumes L<Dancer2::Core::Role::SessionFactory> to know about that. + +Generally, session objects should not be created directly. The correct way to +get a new session object is to call the C<create()> method on a session engine +that implements the SessionFactory role. This is done automatically by the +app object if a session engine is defined. + +=head1 ATTRIBUTES + +=head2 id + +The identifier of the session object. Required. By default, +L<Dancer2::Core::Role::SessionFactory> sets this to a randomly-generated, +guaranteed-unique string. + +This attribute can be modified if your Session implementation requires this. + +=head2 data + +Contains the data of the session (Hash). + +=head2 expires + +Number of seconds for the expiry of the session cookie. Don't add the current +timestamp to it, will be done automatically. + +Default is no expiry (session cookie will leave for the whole browser's +session). + +For a lifetime of one hour: + + expires => 3600 + +=head2 is_dirty + +Boolean value for whether data in the session has been modified. + +=head1 METHODS + +=head2 read + +Reader on the session data + + my $value = $session->read('something'); + +Returns C<undef> if the key does not exist in the session. + +=head2 write + +Writer on the session data + + $session->write('something', $value); + +Sets C<is_dirty> to true. Returns C<$value>. + +=head2 delete + +Deletes a key from session data + + $session->delete('something'); + +Sets C<is_dirty> to true. Returns the value deleted from the session. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Time.pm b/lib/Dancer2/Core/Time.pm new file mode 100644 index 00000000..5296b0e4 --- /dev/null +++ b/lib/Dancer2/Core/Time.pm @@ -0,0 +1,201 @@ +package Dancer2::Core::Time; +# ABSTRACT: class to handle common helpers for time manipulations +$Dancer2::Core::Time::VERSION = '0.300000'; +use Moo; + +has seconds => ( + is => 'ro', + lazy => 1, + builder => '_build_seconds', +); + +sub _build_seconds { + my ($self) = @_; + my $seconds = $self->expression; + + return $seconds + if $seconds =~ /^\d+$/; + + return $self->_parse_duration($seconds) +} + +has epoch => ( + is => 'ro', + lazy => 1, + builder => '_build_epoch', +); + +sub _build_epoch { + my ($self) = @_; + return $self->seconds if $self->seconds !~ /^[\-\+]?\d+$/; + $self->seconds + time; +} + +has gmt_string => ( + is => 'ro', + builder => '_build_gmt_string', + lazy => 1, +); + +sub _build_gmt_string { + my ($self) = @_; + my $epoch = $self->epoch; + return $epoch if $epoch !~ /^\d+$/; + + my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime($epoch); + my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); + my @days = qw(Sun Mon Tue Wed Thu Fri Sat); + + return sprintf "%s, %02d-%s-%d %02d:%02d:%02d GMT", + $days[$wday], + $mday, + $months[$mon], + ( $year + 1900 ), + $hour, $min, $sec; +} + +has expression => ( + is => 'ro', + required => 1, +); + +sub BUILDARGS { + my ($class, %args) = @_; + + $args{epoch} = $args{expression} + if $args{expression} =~ /^\d+$/; + + return \%args; +} + +# private + +# This map is taken from Cache and Cache::Cache +# map of expiration formats to their respective time in seconds +#<<< no perl tidy +my %Units = ( map(($_, 1), qw(s second seconds sec secs)), + map(($_, 60), qw(m minute minutes min mins)), + map(($_, 60*60), qw(h hr hour hours)), + map(($_, 60*60*24), qw(d day days)), + map(($_, 60*60*24*7), qw(w week weeks)), + map(($_, 60*60*24*30), qw(M month months)), + map(($_, 60*60*24*365), qw(y year years)) ); +#>>> + +# This code is taken from Time::Duration::Parse, except if it isn't +# understood it just passes it through and it adds the current time. +sub _parse_duration { + my ( $self, $timespec ) = @_; + my $orig_timespec = $timespec; + + # Treat a plain number as a number of seconds (and parse it later) + if ( $timespec =~ /^\s*([-+]?\d+(?:[.,]\d+)?)\s*$/ ) { + $timespec = "$1s"; + } + + # Convert hh:mm(:ss)? to something we understand + $timespec =~ s/\b(\d+):(\d\d):(\d\d)\b/$1h $2m $3s/g; + $timespec =~ s/\b(\d+):(\d\d)\b/$1h $2m/g; + + my $duration = 0; + while ( $timespec + =~ s/^\s*([-+]?\d+(?:[.,]\d+)?)\s*([a-zA-Z]+)(?:\s*(?:,|and)\s*)*//i ) + { + my ( $amount, $unit ) = ( $1, $2 ); + $unit = lc($unit) unless length($unit) == 1; + + if ( my $value = $Units{$unit} ) { + $amount =~ s/,/./; + $duration += $amount * $value; + } + else { + return $orig_timespec; + } + } + + if ( $timespec =~ /\S/ ) { + return $orig_timespec; + } + + return sprintf "%.0f", $duration; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Time - class to handle common helpers for time manipulations + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + my $time = Dancer2::Core::Time->new( expression => "1h" ); + $time->seconds; # return 3600 + +=head1 DESCRIPTION + +For consistency, whenever something needs to work with time, it +needs to be expressed in seconds, with a timestamp. Although it's very +convenient for the machine and calculations, it's not very handy for a +human-being, for instance in a configuration file. + +This class provides everything needed to translate any human-understandable +expression into a number of seconds. + +=head1 ATTRIBUTES + +=head2 seconds + +Number of seconds represented by the object. Defaults to 0. + +=head2 epoch + +The current epoch to handle. Defaults to seconds + time. + +=head2 gmt_string + +Convert the current value in epoch as a GMT string. + +=head2 expression + +Required. A human readable expression representing the number of seconds to provide. + +The format supported is a number followed by an expression. It currently +understands: + + s second seconds sec secs + m minute minutes min mins + h hr hour hours + d day days + w week weeks + M month months + y year years + +Months and years are currently fixed at 30 and 365 days. This may change. +Anything else is used verbatim as the expression of a number of seconds. + +Example: + + 2 hours, 3 days, 3d, 1 week, 3600, etc... + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Core/Types.pm b/lib/Dancer2/Core/Types.pm new file mode 100644 index 00000000..3133e97c --- /dev/null +++ b/lib/Dancer2/Core/Types.pm @@ -0,0 +1,149 @@ +package Dancer2::Core::Types; +# ABSTRACT: Type::Tiny types for Dancer2 core. +$Dancer2::Core::Types::VERSION = '0.300000'; +use strict; +use warnings; +use Type::Library -base; +use Type::Utils -all; +use Sub::Quote 'quote_sub'; + +BEGIN { extends "Types::Standard" }; + +our %supported_http_methods = map +( $_ => 1 ), qw< + GET HEAD POST PUT DELETE OPTIONS PATCH +>; + +my $single_part = qr/ + [A-Za-z] # must start with letter + (?: [A-Za-z0-9_]+ )? # can continue with letters, numbers or underscore +/x; + +my $namespace = qr/ + ^ + $single_part # first part + (?: (?: \:\: $single_part )+ )? # optional part starting with double colon + $ +/x; + +declare 'ReadableFilePath', constraint => quote_sub q{ -e $_ && -r $_ }; + +declare 'WritableFilePath', constraint => quote_sub q{ -e $_ && -w $_ }; + +declare 'Dancer2Prefix', as 'Str', where { + # a prefix must start with the char '/' + # index is much faster than =~ /^\// + index($_, '/') == 0 +}; + +declare 'Dancer2AppName', as 'Str', where { + # TODO need a real check of valid app names + $_ =~ $namespace; +}, message { + sprintf("%s is not a Dancer2AppName", + ($_ && length($_)) ? $_ : 'Empty string') +}; + +declare 'Dancer2Method', as Enum [map +(lc), keys %supported_http_methods]; + +declare 'Dancer2HTTPMethod', as Enum [keys %supported_http_methods]; + +# generate abbreviated class types for core dancer objects +for my $type ( + qw/ + App + Context + Cookie + DSL + Dispatcher + Error + Hook + MIME + Request + Response + Role + Route + Runner + Server + Session + Types + / + ) +{ + declare $type, + as InstanceOf[ 'Dancer2::Core::' . $type ]; +} + +# Export everything by default. +our @EXPORT = __PACKAGE__->type_names; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Core::Types - Type::Tiny types for Dancer2 core. + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +L<Type::Tiny> definitions for Moo attributes. These are defined as subroutines. + +=head1 MOO TYPES + +=head2 ReadableFilePath($value) + +A readable file path. + +=head2 WritableFilePath($value) + +A writable file path. + +=head2 Dancer2Prefix($value) + +A proper Dancer2 prefix, which is basically a prefix that starts with a I</> +character. + +=head2 Dancer2AppName($value) + +A proper Dancer2 application name. + +Currently this only checks for I<\w+>. + +=head2 Dancer2Method($value) + +An acceptable method supported by Dancer2. + +Currently this includes: I<get>, I<head>, I<post>, I<put>, I<delete> and +I<options>. + +=head2 Dancer2HTTPMethod($value) + +An acceptable HTTP method supported by Dancer2. + +Current this includes: I<GET>, I<HEAD>, I<POST>, I<PUT>, I<DELETE> +and I<OPTIONS>. + +=head1 SEE ALSO + +L<Types::Standard> for more available types + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/FileUtils.pm b/lib/Dancer2/FileUtils.pm new file mode 100644 index 00000000..9a19f71c --- /dev/null +++ b/lib/Dancer2/FileUtils.pm @@ -0,0 +1,243 @@ +package Dancer2::FileUtils; +# ABSTRACT: File utility helpers +$Dancer2::FileUtils::VERSION = '0.300000'; +use strict; +use warnings; + +use File::Basename (); +use File::Spec; +use Carp; + +use Exporter 'import'; +our @EXPORT_OK = qw( + dirname open_file path read_file_content read_glob_content + path_or_empty set_file_mode normalize_path escape_filename +); + + +sub path { + my @parts = @_; + my $path = File::Spec->catfile(@parts); + + return normalize_path($path); +} + +sub path_or_empty { + my @parts = @_; + my $path = path(@parts); + + # return empty if it doesn't exist + return -e $path ? $path : ''; +} + +sub dirname { File::Basename::dirname(@_) } + +sub set_file_mode { + my $fh = shift; + my $charset = 'utf-8'; + binmode $fh, ":encoding($charset)"; + return $fh; +} + +sub open_file { + my ( $mode, $filename ) = @_; + + open my $fh, $mode, $filename + or croak "Can't open '$filename' using mode '$mode': $!"; + + return set_file_mode($fh); +} + +sub read_file_content { + my $file = shift or return; + my $fh = open_file( '<', $file ); + + return wantarray + ? read_glob_content($fh) + : scalar read_glob_content($fh); +} + +sub read_glob_content { + my $fh = shift; + + my @content = <$fh>; + close $fh; + + return wantarray ? @content : join '', @content; +} + +sub normalize_path { + + # this is a revised version of what is described in + # http://www.linuxjournal.com/content/normalizing-path-names-bash + # by Mitch Frazier + my $path = shift or return; + my $seqregex = qr{ + [^/]* # anything without a slash + /\.\.(/|\z) # that is accompanied by two dots as such + }x; + + $path =~ s{/\./}{/}g; + while ( $path =~ s{$seqregex}{} ) {} + + #see https://rt.cpan.org/Public/Bug/Display.html?id=80077 + $path =~ s{^//}{/}; + return $path; +} + +sub escape_filename { + my $filename = shift or return; + + # based on escaping used in CHI::Driver. Our use-case is one-way, + # so we allow utf8 chars to be escaped, but NEVER do the inverse + # operation. + $filename =~ s/([^A-Za-z0-9_\=\-\~])/sprintf("+%02x", ord($1))/ge; + return $filename; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::FileUtils - File utility helpers + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + use Dancer2::FileUtils qw/dirname path path_or_empty/; + + # for 'path/to/file' + my $dir = dirname($path); # returns 'path/to' + my $path = path($path); # returns '/abs/path/to/file' + my $path = path_or_empty($path); # returns '' if file doesn't exist + + + use Dancer2::FileUtils qw/path read_file_content/; + + my $content = read_file_content( path( 'folder', 'folder', 'file' ) ); + my @content = read_file_content( path( 'folder', 'folder', 'file' ) ); + + + use Dancer2::FileUtils qw/read_glob_content set_file_mode/; + + open my $fh, '<', $file or die "$!\n"; + set_file_mode($fh); + my @content = read_glob_content($fh); + my $content = read_glob_content($fh); + + + use Dancer2::FileUtils qw/open_file/; + + my $fh = open_file('<', $file) or die $message; + + + use Dancer2::FileUtils 'set_file_mode'; + + set_file_mode($fh); + +=head1 DESCRIPTION + +Dancer2::FileUtils includes a few file related utilities that Dancer2 +uses internally. Developers may use it instead of writing their own +file reading subroutines or using additional modules. + +=head1 FUNCTIONS + +=head2 my $path = path( 'folder', 'folder', 'filename'); + +Provides comfortable path resolution, internally using L<File::Spec>. 'path' +does not verify paths, it just normalizes the path. + +=head2 my $path = path_or_empty('folder, 'folder','filename'); + +Like path, but returns '' if path doesn't exist. + +=head2 dirname + + use Dancer2::FileUtils 'dirname'; + + my $dir = dirname($path); + +Exposes L<File::Basename>'s I<dirname>, to allow fetching a directory name from +a path. On most OS, returns all but last level of file path. See +L<File::Basename> for details. + +=head2 set_file_mode($fh); + + use Dancer2::FileUtils 'set_file_mode'; + + set_file_mode($fh); + +Applies charset setting from Dancer2's configuration. Defaults to utf-8 if no +charset setting. + +=head2 my $fh = open_file('<', $file) or die $message; + + use Dancer2::FileUtils 'open_file'; + my $fh = open_file('<', $file) or die $message; + +Calls open and returns a filehandle. Takes in account the 'charset' setting +from Dancer2's configuration to open the file in the proper encoding (or +defaults to utf-8 if setting not present). + +=head2 my $content = read_file_content($file); + + use Dancer2::FileUtils 'read_file_content'; + + my @content = read_file_content($file); + my $content = read_file_content($file); + +Returns either the content of a file (whose filename is the input), or I<undef> +if the file could not be opened. + +In array context it returns each line (as defined by $/) as a separate element; +in scalar context returns the entire contents of the file. + +=head2 my $content = read_glob_content($fh); + + use Dancer2::FileUtils 'read_glob_content'; + + open my $fh, '<', $file or die "$!\n"; + binmode $fh, ':encoding(utf-8)'; + my @content = read_glob_content($fh); + my $content = read_glob_content($fh); + +Similar to I<read_file_content>, only it accepts a file handle. It is +assumed that the appropriate PerlIO layers are applied to the file handle. +Returns the content and B<closes the file handle>. + +=head2 my $norm_path=normalize_path ($path); + +=head2 my $escaped_filename = escape_filename( $filename ); + +Escapes characters in a filename that may alter a path when concatenated. + + use Dancer2::FileUtils 'escape_filename'; + + my $safe = escape_filename( "a/../b.txt" ); # a+2f+2e+2e+2fb+2etxt + +=head1 EXPORT + +Nothing by default. You can provide a list of subroutines to import. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Handler/AutoPage.pm b/lib/Dancer2/Handler/AutoPage.pm new file mode 100644 index 00000000..220926e0 --- /dev/null +++ b/lib/Dancer2/Handler/AutoPage.pm @@ -0,0 +1,127 @@ +package Dancer2::Handler::AutoPage; +# ABSTRACT: Class for handling the AutoPage feature +$Dancer2::Handler::AutoPage::VERSION = '0.300000'; +use Moo; +use Carp 'croak'; +use Dancer2::Core::Types; + +with qw< + Dancer2::Core::Role::Handler + Dancer2::Core::Role::StandardResponses +>; + +sub register { + my ( $self, $app ) = @_; + + return unless $app->config->{auto_page}; + + $app->add_route( + method => $_, + regexp => $self->regexp, + code => $self->code, + ) for $self->methods; +} + +sub code { + sub { + my $app = shift; + my $prefix = shift; + + my $template = $app->template_engine; + if ( !defined $template ) { + $app->response->has_passed(1); + return; + } + + my $page = $app->request->path; + my $layout_dir = $template->layout_dir; + if ( $page =~ m{^/\Q$layout_dir\E/} ) { + $app->response->has_passed(1); + return; + } + + # remove leading '/', ensuring paths relative to the view + $page =~ s{^/}{}; + my $view_path = $template->view_pathname($page); + + if ( ! $template->pathname_exists( $view_path ) ) { + $app->response->has_passed(1); + return; + } + + my $ct = $template->process( $page ); + return ( $app->request->method eq 'GET' ) ? $ct : ''; + }; +} + +sub regexp {'/**'} + +sub methods {qw(head get)} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Handler::AutoPage - Class for handling the AutoPage feature + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +The AutoPage feature is a Handler (turned off by default) that is +responsible for serving pages that match an existing template. If a +view exists with a name that matches the requested path, Dancer2 +processes the request using the Autopage handler. + +To turn it add to your config file: + + auto_page: 1 + +This allows you to easily serve simple pages without having to write a +route definition for them. + +If there's no view with the name request, the route passes, allowing +other matching routes to be dispatched. + +=head1 METHODS + +=head2 register + +Creates the routes. + +=head2 code + +A code reference that processes the route request. + +=head2 methods + +The methods that should be served for autopages. + +Default: B<head>, B<get>. + +=head2 regexp + +The regexp (path) we want to match. + +Default: B</:page>. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Handler/File.pm b/lib/Dancer2/Handler/File.pm new file mode 100644 index 00000000..2dd3bbcb --- /dev/null +++ b/lib/Dancer2/Handler/File.pm @@ -0,0 +1,179 @@ +package Dancer2::Handler::File; +# ABSTRACT: class for handling file content rendering +$Dancer2::Handler::File::VERSION = '0.300000'; +use Carp 'croak'; +use Moo; +use HTTP::Date; +use Dancer2::FileUtils 'path', 'open_file', 'read_glob_content'; +use Dancer2::Core::MIME; +use Dancer2::Core::Types; +use File::Spec; + +with qw< + Dancer2::Core::Role::Handler + Dancer2::Core::Role::StandardResponses + Dancer2::Core::Role::Hookable +>; + +sub hook_aliases { + { + before_file_render => 'handler.file.before_render', + after_file_render => 'handler.file.after_render', + } +} + +sub supported_hooks { values %{ shift->hook_aliases } } + +has mime => ( + is => 'ro', + isa => InstanceOf ['Dancer2::Core::MIME'], + default => sub { Dancer2::Core::MIME->new }, +); + +has encoding => ( + is => 'ro', + default => sub {'utf-8'}, +); + +has public_dir => ( + is => 'ro', + lazy => 1, + builder => '_build_public_dir', +); + +has regexp => ( + is => 'ro', + default => sub {'/**'}, +); + +sub _build_public_dir { + my $self = shift; + return $self->app->config->{public_dir} + || $ENV{DANCER_PUBLIC} + || path( $self->app->location, 'public' ); +} + +sub register { + my ( $self, $app ) = @_; + + # don't register the handler if no valid public dir + return if !-d $self->public_dir; + + $app->add_route( + method => $_, + regexp => $self->regexp, + code => $self->code( $app->prefix ), + ) for $self->methods; +} + +sub methods { ( 'head', 'get' ) } + +sub code { + my ( $self, $prefix ) = @_; + + sub { + my $app = shift; + my $prefix = shift; + my $path = $app->request->path_info; + + if ( $path =~ /\0/ ) { + return $self->standard_response( $app, 400 ); + } + + if ( $prefix && $prefix ne '/' ) { + $path =~ s/^\Q$prefix\E//; + } + + my $file_path = $self->merge_paths( $path, $self->public_dir ); + return $self->standard_response( $app, 403 ) if !defined $file_path; + + if ( !-f $file_path ) { + $app->response->has_passed(1); + return; + } + + if ( !-r $file_path ) { + return $self->standard_response( $app, 403 ); + } + + # Now we are sure we can render the file... + $self->execute_hook( 'handler.file.before_render', $file_path ); + + # Read file content as bytes + my $fh = open_file( "<", $file_path ); + binmode $fh; + my $content = read_glob_content($fh); + + # Assume m/^text/ mime types are correctly encoded + my $content_type = $self->mime->for_file($file_path) || 'text/plain'; + if ( $content_type =~ m!^text/! ) { + $content_type .= "; charset=" . ( $self->encoding || "utf-8" ); + } + + my @stat = stat $file_path; + + $app->response->header('Content-Type') + or $app->response->header( 'Content-Type', $content_type ); + + $app->response->header('Content-Length') + or $app->response->header( 'Content-Length', $stat[7] ); + + $app->response->header('Last-Modified') + or $app->response->header( + 'Last-Modified', + HTTP::Date::time2str( $stat[9] ) + ); + + $app->response->content($content); + $app->response->is_encoded(1); # bytes are already encoded + $self->execute_hook( 'handler.file.after_render', $app->response ); + return ( $app->request->method eq 'GET' ) ? $content : ''; + }; +} + +sub merge_paths { + my ( undef, $path, $public_dir ) = @_; + + my ( $volume, $dirs, $file ) = File::Spec->splitpath( $path ); + my @tokens = File::Spec->splitdir( "$dirs$file" ); + my $updir = File::Spec->updir; + return if grep $_ eq $updir, @tokens; + + my ( $pub_vol, $pub_dirs, $pub_file ) = File::Spec->splitpath( $public_dir ); + my @pub_tokens = File::Spec->splitdir( "$pub_dirs$pub_file" ); + return if length $volume and length $pub_vol and $volume ne $pub_vol; + + my @final_vol = ( length $pub_vol ? $pub_vol : length $volume ? $volume : () ); + my @file_path = ( @final_vol, @pub_tokens, @tokens ); + my $file_path = path( @file_path ); + return $file_path; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Handler::File - class for handling file content rendering + +=head1 VERSION + +version 0.300000 + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Logger/Capture.pm b/lib/Dancer2/Logger/Capture.pm new file mode 100644 index 00000000..87c09c3b --- /dev/null +++ b/lib/Dancer2/Logger/Capture.pm @@ -0,0 +1,141 @@ +package Dancer2::Logger::Capture; +# ABSTRACT: Capture dancer logs +$Dancer2::Logger::Capture::VERSION = '0.300000'; +use Moo; +use Dancer2::Logger::Capture::Trap; + +with 'Dancer2::Core::Role::Logger'; + +has trapper => ( + is => 'ro', + lazy => 1, + builder => '_build_trapper', +); + +sub _build_trapper { Dancer2::Logger::Capture::Trap->new } + +sub log { + my ( $self, $level, $message ) = @_; + + $self->trapper->store( + $level, $message, $self->format_message( $level => $message ) + ); + + return; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Logger::Capture - Capture dancer logs + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + +The basics: + + set logger => "capture"; + + my $trap = dancer_app->logger_engine->trapper; + my $logs = $trap->read; + +A worked-out real-world example: + + use Test::More tests => 2; + use Dancer2; + + set logger => 'capture'; + + warning "Danger! Warning!"; + debug "I like pie."; + + my $trap = dancer_app->logger_engine->trapper; + + is_deeply $trap->read, [ + { level => "warning", message => "Danger! Warning!" }, + { level => "debug", message => "I like pie.", } + ]; + + # each call to read cleans the trap + is_deeply $trap->read, []; + +=head1 DESCRIPTION + +This is a logger class for L<Dancer2> which captures all logs to an object. + +It's primary purpose is for testing. Here is an example of a test: + + use strict; + use warnings; + use Test::More; + use Plack::Test; + use HTTP::Request::Common; + use Ref::Util qw<is_coderef>; + + { + package App; + use Dancer2; + + set log => 'debug'; + set logger => 'capture'; + + get '/' => sub { + log(debug => 'this is my debug message'); + log(core => 'this should not be logged'); + log(info => 'this is my info message'); + }; + } + + my $app = Dancer2->psgi_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + my $res = $cb->( GET '/' ); + + my $trap = App->dancer_app->logger_engine->trapper; + + is_deeply $trap->read, [ + { level => 'debug', message => 'this is my debug message' }, + { level => 'info', message => 'this is my info message' }, + ]; + + is_deeply $trap->read, []; + }; + + done_testing; + +=head1 METHODS + +=head2 trapper + +Returns the L<Dancer2::Logger::Capture::Trap> object used to capture +and read logs. + +=head1 SEE ALSO + +L<Dancer2::Core::Role::Logger>, L<Dancer2::Logger::Capture::Trap> + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Logger/Capture/Trap.pm b/lib/Dancer2/Logger/Capture/Trap.pm new file mode 100644 index 00000000..df9eaf80 --- /dev/null +++ b/lib/Dancer2/Logger/Capture/Trap.pm @@ -0,0 +1,94 @@ +package Dancer2::Logger::Capture::Trap; +# ABSTRACT: a place to store captured Dancer2 logs +$Dancer2::Logger::Capture::Trap::VERSION = '0.300000'; +use Moo; +use Dancer2::Core::Types; + +has storage => ( + is => 'rw', + isa => ArrayRef, + default => sub { [] }, +); + +sub store { + my ( $self, $level, $message, $fmt_string ) = @_; + push @{ $self->storage }, { + level => $level, + message => $message, + formatted => $fmt_string, + }; +} + +sub read { + my $self = shift; + + my $logs = $self->storage; + $self->storage( [] ); + return $logs; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Logger::Capture::Trap - a place to store captured Dancer2 logs + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + my $trap = Dancer2::Logger::Capture::Trap->new; + $trap->store( $level, $message ); + my $logs = $trap->read; + +=head1 DESCRIPTION + +This is a place to store and retrieve capture Dancer2 logs used by +L<Dancer2::Logger::Capture>. + +=head2 Methods + +=head3 new + +=head3 store + + $trap->store($level, $message); + +Stores a log $message and its $level. + +=head3 read + + my $logs = $trap->read; + +Returns the logs stored as an array ref and clears the storage. + +For example... + + [{ level => "warning", message => "Danger! Warning! Dancer2!" }, + { level => "error", message => "You fail forever" } + ]; + +=head1 SEE ALSO + +L<Dancer2::Logger::Capture> + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Logger/Console.pm b/lib/Dancer2/Logger/Console.pm new file mode 100644 index 00000000..9ec24fdb --- /dev/null +++ b/lib/Dancer2/Logger/Console.pm @@ -0,0 +1,62 @@ +package Dancer2::Logger::Console; +# ABSTRACT: Console logger +$Dancer2::Logger::Console::VERSION = '0.300000'; +use Moo; + +with 'Dancer2::Core::Role::Logger'; + +sub log { + my ( $self, $level, $message ) = @_; + print STDERR $self->format_message( $level => $message ); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Logger::Console - Console logger + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This is a logging engine that allows you to print debug messages on the +standard error output. + +=head1 METHODS + +=head2 log + +Writes the log message to the console. + +=head1 CONFIGURATION + +The setting C<logger> should be set to C<console> in order to use this logging +engine in a Dancer2 application. + +There is no additional setting available with this engine. + +=head1 SEE ALSO + +L<Dancer2::Core::Role::Logger> + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Logger/Diag.pm b/lib/Dancer2/Logger/Diag.pm new file mode 100644 index 00000000..be27b283 --- /dev/null +++ b/lib/Dancer2/Logger/Diag.pm @@ -0,0 +1,55 @@ +package Dancer2::Logger::Diag; +# ABSTRACT: Test::More diag() logging engine for Dancer2 +$Dancer2::Logger::Diag::VERSION = '0.300000'; +use Moo; +use Test::More; + +with 'Dancer2::Core::Role::Logger'; + +sub log { + my ( $self, $level, $message ) = @_; + + Test::More::diag( $self->format_message( $level => $message ) ); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Logger::Diag - Test::More diag() logging engine for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This logging engine uses L<Test::More>'s diag() to output as TAP comments. + +This is very useful in case you're writing a test and want to have logging +messages as part of your TAP. + +=head1 METHODS + +=head2 log + +Use Test::More's diag() to output the log message. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Logger/File.pm b/lib/Dancer2/Logger/File.pm new file mode 100644 index 00000000..29b5790d --- /dev/null +++ b/lib/Dancer2/Logger/File.pm @@ -0,0 +1,173 @@ +package Dancer2::Logger::File; +# ABSTRACT: file-based logging engine for Dancer2 +$Dancer2::Logger::File::VERSION = '0.300000'; +use Carp 'carp'; +use Moo; +use Dancer2::Core::Types; + +with 'Dancer2::Core::Role::Logger'; + +use File::Spec; +use Fcntl qw(:flock SEEK_END); +use Dancer2::FileUtils qw(open_file); +use IO::File; + +has environment => ( + is => 'ro', + required => 1, +); + +has location => ( + is => 'ro', + required => 1, +); + +has log_dir => ( + is => 'rw', + isa => sub { + my $dir = shift; + + if ( !-d $dir && !mkdir $dir ) { + die "log directory \"$dir\" does not exist and unable to create it."; + } + if ( !-w $dir ) { + die "log directory \"$dir\" is not writable." + } + }, + lazy => 1, + builder => '_build_log_dir', +); + +has file_name => ( + is => 'ro', + isa => Str, + builder => '_build_file_name', + lazy => 1 +); + +has log_file => ( + is => 'ro', + isa => Str, + lazy => 1, + builder => '_build_log_file', +); + +has fh => ( + is => 'ro', + lazy => 1, + builder => '_build_fh', +); + +sub _build_log_dir { File::Spec->catdir( $_[0]->location, 'logs' ) } + +sub _build_file_name {$_[0]->environment . ".log"} + +sub _build_log_file { + my $self = shift; + return File::Spec->catfile( $self->log_dir, $self->file_name ); +} + +sub _build_fh { + my $self = shift; + my $logfile = $self->log_file; + + my $fh; + unless ( $fh = open_file( '>>', $logfile ) ) { + carp "unable to create or append to $logfile"; + return; + } + + $fh->autoflush; + + return $fh; +} + +sub log { + my ( $self, $level, $message ) = @_; + my $fh = $self->fh; + + return unless ( ref $fh && $fh->opened ); + + flock( $fh, LOCK_EX ) + or carp "locking logfile $self->{logfile} failed: $!"; + seek( $fh, 0, SEEK_END ); + $fh->print( $self->format_message( $level => $message ) ) + or carp "writing to logfile $self->{logfile} failed"; + flock( $fh, LOCK_UN ) + or carp "unlocking logfile $self->{logfile} failed: $!"; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Logger::File - file-based logging engine for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This is a logging engine that allows you to save your logs to files on disk. + +Logs are not automatically rotated. Use a log rotation tool like +C<logrotate> in C<copytruncate> mode. + +=head1 METHODS + +=head2 log($level, $message) + +Writes the log message to the file. + +=head1 CONFIGURATION + +The setting C<logger> should be set to C<File> in order to use this logging +engine in a Dancer2 application. + +The follow attributes are supported: + +=over 4 + +=item * C<log_dir> + +Directory path to hold log files. + +Defaults to F<logs> in the application directory + +=item * C<file_name> + +The name of the log file. + +Defaults to the environment name with a F<.log> suffix + +=back + +Here is an example configuration that use this logger and stores logs in F</var/log/myapp>: + + logger: "File" + + engines: + logger: + File: + log_dir: "/var/log/myapp" + file_name: "myapp.log" + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Logger/Note.pm b/lib/Dancer2/Logger/Note.pm new file mode 100644 index 00000000..fa58a862 --- /dev/null +++ b/lib/Dancer2/Logger/Note.pm @@ -0,0 +1,58 @@ +package Dancer2::Logger::Note; +# ABSTRACT: Test::More note() logging engine for Dancer2 +$Dancer2::Logger::Note::VERSION = '0.300000'; +use Moo; +use Test::More; + +with 'Dancer2::Core::Role::Logger'; + +sub log { + my ( $self, $level, $message ) = @_; + + Test::More::note( $self->format_message( $level => $message ) ); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Logger::Note - Test::More note() logging engine for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This logging engine uses L<Test::More>'s note() to output as TAP comments. + +This is very useful in case you're writing a test and want to have logging +messages as part of your TAP. + +"Like C<diag()>, except the message will not be seen when the test is run in a +harness. It will only be visible in the verbose TAP stream." -- Test::More. + +=head1 METHODS + +=head2 log + +Use Test::More's note() to output the log message. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Logger/Null.pm b/lib/Dancer2/Logger/Null.pm new file mode 100644 index 00000000..62d68035 --- /dev/null +++ b/lib/Dancer2/Logger/Null.pm @@ -0,0 +1,47 @@ +package Dancer2::Logger::Null; +# ABSTRACT: Blackhole-like silent logging engine for Dancer2 +$Dancer2::Logger::Null::VERSION = '0.300000'; +use Moo; +with 'Dancer2::Core::Role::Logger'; + +sub log {1} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Logger::Null - Blackhole-like silent logging engine for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This logger acts as a blackhole (or /dev/null, if you will) that discards all +the log messages instead of displaying them anywhere. + +=head1 METHODS + +=head2 log + +Discards the message. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Manual.pod b/lib/Dancer2/Manual.pod new file mode 100644 index 00000000..cf35d680 --- /dev/null +++ b/lib/Dancer2/Manual.pod @@ -0,0 +1,3368 @@ +# ABSTRACT: A gentle introduction to Dancer2 +package Dancer2::Manual; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Manual - A gentle introduction to Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Dancer2 is a free and open source web application framework written in Perl. + +It's a complete rewrite of L<Dancer>, based on L<Moo> and using a more +robust and extensible fully-OO design. + +It's designed to be powerful and flexible, but also easy to use - getting up +and running with your web app is trivial, and an ecosystem of adaptors for +common template engines, session storage, logging methods, serializers, and +plugins to make common tasks easy means you can do what you want to do, your +way, easily. + +=head1 INSTALL + +Installation of Dancer2 is simple, using your favourite method to install from +CPAN, e.g.: + + perl -MCPAN -e 'install Dancer2' + +Thanks to the magic of cpanminus, if you do not have CPAN.pm configured, or +just want a quickfire way to get running, the following should work, at +least on Unix-like systems: + + wget -O - http://cpanmin.us | sudo perl - Dancer2 + +(If you don't have root access, omit the 'sudo', and cpanminus will install +Dancer2 and prereqs into C<~/perl5>.) + +Dancer2 is also available as a package from the package repository of several +distributions, for example on Debian/Ubuntu you should be able to just: + + apt-get install libdancer2-perl + +Do be aware, though, that distribution-packaged versions sometimes lag behind +the most recent version on CPAN. + +=head1 BOOTSTRAPPING A NEW APP + +Create a web application using the dancer script: + + $ dancer2 -a MyApp && cd MyApp + + MyApp + + MyApp/config.yml + + MyApp/Makefile.PL + + MyApp/MANIFEST.SKIP + + MyApp/.dancer + + MyApp/cpanfile + + MyApp/bin + + MyApp/bin/app.psgi + + MyApp/environments + + MyApp/environments/development.yml + + MyApp/environments/production.yml + + MyApp/lib + + MyApp/lib/MyApp.pm + + MyApp/public + + MyApp/public/favicon.ico + + MyApp/public/500.html + + MyApp/public/dispatch.cgi + + MyApp/public/404.html + + MyApp/public/dispatch.fcgi + + MyApp/public/css + + MyApp/public/css/error.css + + MyApp/public/css/style.css + + MyApp/public/images + + MyApp/public/images/perldancer.jpg + + MyApp/public/images/perldancer-bg.jpg + + MyApp/public/javascripts + + MyApp/public/javascripts/jquery.js + + MyApp/t + + MyApp/t/001_base.t + + MyApp/t/002_index_route.t + + MyApp/views + + MyApp/views/index.tt + + MyApp/views/layouts + + MyApp/views/layouts/main.tt + +It creates a directory named after the name of the app, along with a +configuration file, a views directory (where your templates and layouts +will live), an environments directory (where environment-specific +settings live), a module containing the actual guts of your application, and +a script to start it. A default skeleton is used to bootstrap the new +application, but you can use the C<-s> option to provide another skeleton. +For example: + + $ dancer2 -a MyApp -s ~/mydancerskel + +For an example of a skeleton directory check the default one available in +the C<share/> directory of your Dancer2 distribution. + +(In what follows we will refer to the directory in which you have created your +Dancer2 application -- I<e.g.,> what C<MyApp> was above -- as the +C<appdir>.) + +Because Dancer2 is a L<PSGI> web application framework, you can use the +C<plackup> tool (provided by L<Plack>) for launching the application: + + plackup -p 5000 bin/app.psgi + +View the web application at: + + http://localhost:5000 + +=head1 USAGE + +When Dancer2 is imported to a script, that script becomes a webapp, and at +this point, all the script has to do is declare a list of B<routes>. A +route handler is composed by an HTTP method, a path pattern and a code +block. C<strict>, C<warnings> and C<utf8> pragmas are also imported with +Dancer2. + +The code block given to the route handler has to return a string which will +be used as the content to render to the client. + +Routes are defined for a given HTTP method. For each method supported, a +keyword is exported by the module. + +=head2 HTTP Methods + +Here are some of the standard HTTP methods which you can use to define your +route handlers. + +=over 4 + +=item * B<GET> The GET method retrieves information, and is the most common + +GET requests should be used for typical "fetch" requests - retrieving +information. They should not be used for requests which change data on the +server or have other effects. + +When defining a route handler for the GET method, Dancer2 automatically +defines a route handler for the HEAD method (in order to honour HEAD +requests for each of your GET route handlers). + +To define a GET action, use the L<get|Dancer2::Manual/get> keyword. + +=item * B<POST> The POST method is used to create a resource on the server. + +To define a POST action, use the L<post|Dancer2::Manual/post> keyword. + +=item * B<PUT> The PUT method is used to replace an existing resource. + +To define a PUT action, use the L<put|Dancer2::Manual/put> keyword. + +a PUT request should replace the existing resource with that specified - for +instance - if you wanted to just update an email address for a user, you'd +have to specify all attributes of the user again; to make a partial update, +a PATCH request is used. + +=item * B<PATCH> The PATCH method updates some attributes of an existing resource. + +To define a PATCH action, use the L<patch|Dancer2::Manual/patch> keyword. + +=item * B<DELETE> The DELETE method requests that the origin server delete the +resource identified by the Request-URI. + +To define a DELETE action, use the L<del|Dancer2::Manual/del> keyword. + +=back + +=head3 Handling multiple HTTP request methods + +Routes can use C<any> to match all, or a specified list of HTTP methods. + +The following will match any HTTP request to the path C</myaction>: + + any '/myaction' => sub { + # code + } + +The following will match GET or POST requests to C</myaction>: + + any ['get', 'post'] => '/myaction' => sub { + # code + }; + +For convenience, any route which matches GET requests will also match HEAD +requests. + +=head2 Route Handlers + +The route action is the code reference declared. It can access parameters +through the specific L<route_parameters|/route_parameters>, +L<query_parameters|/query_parameters>, and L<body_parameters|/body_parameters> +keywords, which return a L<Hash::MultiValue> object. +This hashref is a merge of the route pattern matches and the request params. + +You can find more details about how params are built and how to access them +in the L<Dancer2::Core::Request> documentation. + +=head3 Declaring Routes + +To control what happens when a web request is received by your webapp, +you'll need to declare C<routes>. A route declaration indicates which HTTP +method(s) it is valid for, the path it matches (e.g. C</foo/bar>), and a +coderef to execute, which returns the response. + + get '/hello/:name' => sub { + return "Hi there " . route_parameters->get('name'); + }; + +The above route specifies that, for GET requests to C</hello/...>, the code +block provided should be executed. + +=head3 Retrieving request parameters + +The L<query_parameters|Dancer2::Manual/query_parameters>, +L<route_parameters|Dancer2::Manual/route_parameters>, and +L<body_parameters|Dancer2::Manual/body_parameters> keywords provide +a L<Hash::MultiValue> result from the three different parameters. + +=head3 Named matching + +A route pattern can contain one or more tokens (a word prefixed with ':'). +Each token found in a route pattern is used as a named-pattern match. Any +match will be set in the route parameters. + + get '/hello/:name' => sub { + "Hey " . route_parameters->get('name') . ", welcome here!"; + }; + +Tokens can be optional, for example: + + get '/hello/:name?' => sub { + my $name = route_parameters->get('name') //= 'Whoever you are'; + "Hello there, $name"; + }; + +=head3 Named matching with type constraints + +Type constraints can be added to tokens. + + get '/user/:id[Int]' => sub { + # matches /user/34 but not /user/jamesdean + my $user_id = route_parameters->get('id'); + }; + + get '/user/:username[Str]' => sub { + # matches /user/jamesdean but not /user/34 since that is caught + # by previous route + my $username = route_parameters->get('username'); + }; + +You can even use type constraints to add a regexp check: + + get '/book/:date[StrMatch[qr{\d\d\d\d-\d\d-\d\d}]]' => sub { + # matches /book/2014-02-04 + my $date = route_parameters->get('date'); + }; + +The default type library is L<Dancer2::Core::Types> but any type library +built using L<Type::Tiny>'s L<Type::Library> can be used instead. +If you'd like to use a different default type library you must declare it +in the configuration file, for example: + + type_library: My::Type::Library + +Alternatively you can specify the type library in which the type is defined +as part of the route definition: + + get '/user/:username[My::Type::Library::Username]' => sub { + my $username = route_parameters->get('username'); + }; + +This will load C<My::Type::Library> and from it use the type C<Username>. This +allows types to be used that are not part of the type library defined by config's +C<type_library>. + +More complex constructs are allowed such as: + + get '/some/:thing[Int|MyDate]' => sub { + ...; + }; + +See L<Type::Registry/lookup($name)> for more details. + +=head3 Wildcard Matching + +A route can contain a wildcard (represented by a C<*>). Each wildcard match +will be placed in a list, which the C<splat> keyword returns. + + get '/download/*.*' => sub { + my ($file, $ext) = splat; + # do something with $file.$ext here + }; + +An extensive, greedier wildcard represented by C<**> (A.K.A. "megasplat") can be +used to define a route. The additional path is broken down and returned as an +arrayref: + + get '/entry/*/tags/**' => sub { + my ( $entry_id, $tags ) = splat; + my @tags = @{$tags}; + }; + +The C<splat> keyword in the above example for the route F</entry/1/tags/one/two> +would set C<$entry_id> to C<1> and C<$tags> to C<['one', 'two']>. + +=head3 Mixed named and wildcard matching + +A route can combine named (token) matching and wildcard matching. +This is useful when chaining actions: + + get '/team/:team/**' => sub { + var team => route_parameters->get('team'); + pass; + }; + + prefix '/team/:team'; + + get '/player/*' => sub { + my ($player) = splat; + + # etc... + }; + + get '/score' => sub { + return score_for( vars->{'team'} ); + }; + +=head3 Regular Expression Matching + +A route can be defined with a Perl regular expression. + +In order to tell Dancer2 to consider the route as a real regexp, the route +must be defined explicitly with C<qr{}>, like the following: + + get qr{/hello/([\w]+)} => sub { + my ($name) = splat; + return "Hello $name"; + }; + +For Perl 5.10+, a route regex may use named capture groups. The C<captures> +keyword will return a reference to a copy of C<%+>. + +=head3 Conditional Matching + +Routes may include some matching conditions (on content_type, agent, +user_agent, content_length and path_info): + + get '/foo', {agent => 'Songbird (\d\.\d)[\d\/]*?'} => sub { + 'foo method for songbird' + } + + get '/foo' => sub { + 'all browsers except songbird' + } + +=head2 Prefix + +A prefix can be defined for each route handler, like this: + + prefix '/home'; + +From here, any route handler is defined to /home/* + + get '/page1' => sub {}; # will match '/home/page1' + +You can unset the prefix value + + prefix '/'; # or: prefix undef; + get '/page1' => sub {}; # will match /page1 + +Alternatively, to prevent you from ever forgetting to undef the prefix, you +can use lexical prefix like this: + + prefix '/home' => sub { + get '/page1' => sub {}; # will match '/home/page1' + }; ## prefix reset to previous value on exit + + get '/page1' => sub {}; # will match /page1 + +=head2 Delayed responses (Async/Streaming) + +L<Dancer2> can provide delayed (otherwise known as I<asynchronous>) responses +using the C<delayed> keyword. These responses are streamed, although you can +set the content all at once, if you prefer. + + get '/status' => sub { + delayed { + response_header 'X-Foo' => 'Bar'; + + # flush headers (in case of streaming) + flush; + + # send content to the user + content 'Hello, world!'; + + # you can write more content + # all streaming + content 'Hello, again!'; + + # when done, close the connection + done; + + # do whatever you want else, asynchronously + # the user socket closed by now + ... + }; + }; + +If you are streaming (calling C<content> several times), you must call +C<flush> first. If you're sending only once, you don't need to call C<flush>. + +Here is an example of using delayed responses with L<AnyEvent>: + + use Dancer2; + use AnyEvent; + + my %timers; + my $count = 5; + get '/drums' => sub { + delayed { + print "Stretching...\n"; + flush; # necessary, since we're streaming + + $timers{'Snare'} = AE::timer 1, 1, delayed { + $timers{'HiHat'} ||= AE::timer 0, 0.5, delayed { + content "Tss...\n"; + }; + + content "Bap!\n"; + + if ( $count-- == 0 ) { + %timers = (); + content "Tugu tugu tugu dum!\n"; + done; + + print "<enter sound of applause>\n\n"; + $timers{'Applause'} = AE::timer 3, 0, sub { + # the DSL will not available here + # because we didn't call the "delayed" keyword + print "<applause dies out>\n"; + }; + } + }; + }; + }; + +If an error happens during a write operation, a warning will be issued +to the logger. + +You can handle the error yourself by providing an C<on_error> handler: + + get '/' => sub { + delayed { + flush; + content "works"; + + # ... user disconnected here ... + + content "fails"; + + # ... error triggered ... + + done; # doesn't even get run + } on_error => sub { + # delayed{} not needed, DSL already available + my ($error) = @_; + # do something with $error + }; + }; + +Here is an example that asynchronously streams the contents of a CSV file: + + use Dancer2; + use Text::CSV_XS qw< csv >; + use Path::Tiny qw< path >; + use JSON::MaybeXS qw< encode_json >; + # Create CSV parser + my $csv = Text::CSV_XS->new({ + binary => 1, + auto_diag => 1, + }); + get '/' => sub { + # delayed response: + delayed { + # streaming content + flush; + # Read each row and stream it in JSON + my $fh = path('filename.csv')->openr_utf8; + while ( my $row = $csv->getline($fh) ) { + content encode_json $row; + } + # close user connection + done; + } on_error => sub { + my ($error) = @_; + warning 'Failed to stream to user: ' . request->remote_address; + }; + }; + +B<NOTE:> If you just want to send a file's contents asynchronously, +use C<send_file($filename)> instead of C<delayed>, as it will +automatically take advantage of any asynchronous capability. + +=head2 Action Skipping + +An action can choose not to serve the current request and ask Dancer2 to +process the request with the next matching route. + +This is done with the B<pass> keyword, like in the following example + + get '/say/:word' => sub { + pass if route_parameters->get('word') =~ /^\d+$/; + "I say a word: " . route_parameters->get('word'); + }; + + get '/say/:number' => sub { + "I say a number: " . route_parameters->get('number'); + }; + +=head1 HOOKS + +Hooks are code references (or anonymous subroutines) that are triggered at +specific moments during the resolution of a request. They are set up using the +L<hook|/hook> keyword. + +Many of them are provided by Dancer2's core, but plugins and engines can also +define their own. + +=over 4 + +=item * C<before> hooks + +C<before> hooks are evaluated before each request within the context of the +request and receives as argument the app (a L<Dancer2::Core::App> object). + +It's possible to define variables which will be accessible in the action +blocks with the L<var keyword|/var>. + + hook before => sub { + var note => 'Hi there'; + }; + + get '/foo/*' => sub { + my ($match) = splat; # 'oversee'; + vars->{note}; # 'Hi there' + }; + +For another example, this can be used along with session support to easily +give non-logged-in users a login page: + + hook before => sub { + if (!session('user') && request->path !~ m{^/login}) { + # Pass the original path requested along to the handler: + forward '/login', { requested_path => request->path }; + } + }; + +The request keyword returns the current L<Dancer2::Core::Request> object +representing the incoming request. + +=item * C<after> hooks + +C<after> hooks are evaluated after the response has been built by a route +handler, and can alter the response itself, just before it's sent to the +client. + +This hook runs after a request has been processed, but before the response +is sent. + +It receives a L<Dancer2::Core::Response> object, which it can modify if it +needs to make changes to the response which is about to be sent. + +The hook can use other keywords in order to do whatever it wants. + + hook after => sub { + response->content( + q{The "after" hook can alter the response's content here!} + ); + }; + +=back + +=head2 Templates + +=over 4 + +=item * C<before_template_render> + +C<before_template_render> hooks are called whenever a template is going to +be processed, they are passed the tokens hash which they can alter. + + hook before_template_render => sub { + my $tokens = shift; + $tokens->{foo} = 'bar'; + }; + +The tokens hash will then be passed to the template with all the +modifications performed by the hook. This is a good way to setup some +global vars you like to have in all your templates, like the name of the +user logged in or a section name. + +=item * C<after_template_render> + +C<after_template_render> hooks are called after the view has been rendered. +They receive as their first argument the reference to the content that has +been produced. This can be used to post-process the content rendered by the +template engine. + + hook after_template_render => sub { + my $ref_content = shift; + my $content = ${$ref_content}; + + # do something with $content + ${$ref_content} = $content; + }; + +=item * C<before_layout_render> + +C<before_layout_render> hooks are called whenever the layout is going to be +applied to the current content. The arguments received by the hook are the +current tokens hashref and a reference to the current content. + + hook before_layout_render => sub { + my ($tokens, $ref_content) = @_; + $tokens->{new_stuff} = 42; + $ref_content = \"new content"; + }; + +=item * C<after_layout_render> + +C<after_layout_render> hooks are called once the complete content of the +view has been produced, after the layout has been applied to the content. +The argument received by the hook is a reference to the complete content +string. + + hook after_layout_render => sub { + my $ref_content = shift; + # do something with ${ $ref_content }, which reflects directly + # in the caller + }; + +=back + +=head2 Error Handling + +Refer to L<Error Hooks|Dancer2::Manual/Error-Hooks> +for details about the following hooks: + +=over 4 + +=item * C<init_error> + +=item * C<before_error> + +=item * C<after_error> + +=item * C<on_route_exception> + +=back + +=head2 File Rendering + +Refer to L<File Handler|Dancer2::Manual/File-Handler> +for details on the following hooks: + +=over 4 + +=item * C<before_file_render> + +=item * C<after_file_render> + +=back + +=head2 Serializers + +=over 4 + +=item * C<before_serializer> is called before serializing the content, and receives +the content to serialize as an argument. + + hook before_serializer => sub { + my $content = shift; + ... + }; + +=item * C<after_serializer> is called after the payload has been serialized, and +receives the serialized content as an argument. + + hook after_serializer => sub { + my $serialized_content = shift; + ... + }; + +=back + +=head1 HANDLERS + +=head2 File Handler + +Whenever a content is produced out of the parsing of a static file, the +L<Dancer2::Handler::File> component is used. This component provides two +hooks, C<before_file_render> and C<after_file_render>. + +C<before_file_render> hooks are called just before starting to parse the +file, the hook receives as its first argument the file path that is going to +be processed. + + hook before_file_render => sub { + my $path = shift; + }; + +C<after_file_render> hooks are called after the file has been parsed and the +response content produced. It receives the response object +(L<Dancer2::Core::Response>) produced. + + hook after_file_render => sub { + my $response = shift; + }; + +=head2 Auto page + +Whenever a page that matches an existing template needs to be served, the +L<Dancer2::Handler::AutoPage> component is used. + +=head2 Writing your own + +A route handler is a class that consumes the L<Dancer2::Core::Role::Handler> +role. The class must implement a set of methods: C<methods>, C<regexp> and +C<code> which will be used to declare the route. + +Let's look at L<Dancer2::Handler::AutoPage> for example. + +First, the matching methods are C<get> and C<head>: + + sub methods { qw(head get) } + +Then, the C<regexp> or the I<path> we want to match: + + sub regexp { '/:page' } + +Anything will be matched by this route, since we want to check if there's +a view named with the value of the C<page> token. If not, the route needs +to C<pass>, letting the dispatching flow to proceed further. + + sub code { + sub { + my $app = shift; + my $prefix = shift; + + my $template = $app->template_engine; + if ( !defined $template ) { + $app->response->has_passed(1); + return; + } + + my $page = $app->request->path; + my $layout_dir = $template->layout_dir; + if ( $page =~ m{^/\Q$layout_dir\E/} ) { + $app->response->has_passed(1); + return; + } + + # remove leading '/', ensuring paths relative to the view + $page =~ s{^/}{}; + my $view_path = $template->view_pathname($page); + + if ( ! $template->pathname_exists( $view_path ) ) { + $app->response->has_passed(1); + return; + } + + my $ct = $template->process( $page ); + return ( $app->request->method eq 'GET' ) ? $ct : ''; + }; + } + +The C<code> method passed the L<Dancer2::Core::App> object which provides +access to anything needed to process the request. + +A C<register> is then implemented to add the route to the registry and if +the C<auto_page setting> is off, it does nothing. + + sub register { + my ($self, $app) = @_; + + return unless $app->config->{auto_page}; + + $app->add_route( + method => $_, + regexp => $self->regexp, + code => $self->code, + ) for $self->methods; + } + +The config parser looks for a C<route_handlers> section and any handler defined +there is loaded. Thus, any random handler can be added to your app. +For example, the default config file for any Dancer2 application is as follows: + + route_handlers: + File: + public_dir: /path/to/public + AutoPage: 1 + +=head1 ERRORS + +=head2 Error Pages + +When an HTTP error occurs (i.e. the action responds with a status code other +than 200), this is how Dancer2 determines what page to display. + +=over + +=item * Looks in the C<views/> directory for a corresponding template file +matching the error code (e.g. C<500.tt> or C<404.tt>). If such a file exists, +it's used to report the error. + +=item * Next, looks in the C<public/> directory for a corresponding HTML file +matching the error code (e.g. C<500.html> or C<404.html>). If such a file +exists, it's used to report the error. (Note, however, that if B<show_errors> +is set to true, in the case of a 500 error the static HTML page will not be +shown, but will be replaced with a default error page containing more +informative diagnostics. For more information see L<Dancer2::Config>.) + +=item * As default, render a generic error page on the fly. + +=back + +=head2 Execution Errors + +When an error occurs during the route execution, Dancer2 will render an +error page with the HTTP status code 500. + +It's possible either to display the content of the error message or to hide +it with a generic error page. This is a choice left to the end-user and can +be controlled with the B<show_errors> setting (see above). + +Note that you can also choose to consider all warnings in your route +handlers as errors when the setting B<warnings> is set to 1. + +=head2 Error Hooks + +When an error is caught by Dancer2's core, an exception object is built (of +the class L<Dancer2::Core::Error>). This class provides a hook to let the +user alter the error workflow if needed. + +C<init_error> hooks are called whenever an error object is built, the object +is passed to the hook. + + hook init_error => sub { + my $error = shift; + # do something with $error + }; + +I<This hook was named B<before_error_init> in Dancer, both names currently +are synonyms for backward-compatibility.> + +C<before_error> hooks are called whenever an error is going to be thrown, it +receives the error object as its sole argument. + + hook before_error => sub { + my $error = shift; + # do something with $error + }; + +I<This hook was named B<before_error_render> in Dancer, both names currently +are synonyms for backward-compatibility.> + +C<after_error> hooks are called whenever an error object has been thrown, it +receives a L<Dancer2::Core::Response> object as its sole argument. + + hook after_error => sub { + my $response = shift; + }; + +I<This hook was named B<after_error_render> in Dancer, both names currently +are synonyms for backward-compatibility.> + +C<on_route_exception> is called when an exception has been caught, at the +route level, just before rethrowing it higher. This hook receives a +L<Dancer2::Core::App> and the error as arguments. + + hook on_route_exception => sub { + my ($app, $error) = @_; + }; + +=head1 SESSIONS + +=head2 Handling sessions + +It's common to want to use sessions to give your web applications state; for +instance, allowing a user to log in, creating a session, and checking that +session on subsequent requests. + +By default Dancer 2 has L<Simple|Dancer2::Session::Simple> sessions enabled. +It implements a very simple in-memory session storage. This will be fast and +useful for testing, but such sessions will not persist between restarts of +your app. + +If you'd like to use a different session engine you must declare it in the +configuration file. + +For example to use YAML file base sessions you need to add the following +to your F<config.yml>: + + session: YAML + +Or, to enable session support from within your code, + + set session => 'YAML'; + +(However, controlling settings is best done from your config file.) + +The L<Dancer2::Session::YAML> backend implements a file-based YAML session +storage to help with debugging, but shouldn't be used on production systems. + +There are other session backends, such as L<Dancer2::Session::Memcached>, +which are recommended for production use. + +You can then use the L<session|Dancer2::Manual/session> keyword to manipulate the +session: + +=head3 Storing data in the session + +Storing data in the session is as easy as: + + session varname => 'value'; + +=head3 Retrieving data from the session + +Retrieving data from the session is as easy as: + + session('varname') + +Or, alternatively, + + session->read("varname") + +=head3 Controlling where sessions are stored + +For disc-based session backends like L<Dancer2::Session::YAML>, +session files are written to the session dir specified by +the C<session_dir> setting, which defaults to C<./sessions> +if not specifically set. + +If you need to control where session files are created, you can do so +quickly and easily within your config file, for example: + + session: YAML + engines: + session: + YAML: + session_dir: /tmp/dancer-sessions + +If the directory you specify does not exist, Dancer2 will attempt to create +it for you. + +=head3 Changing session ID + +If you wish to change the session ID (for example on privilege level change): + + my $new_session_id = app->change_session_id + +=head3 Destroying a session + +When you're done with your session, you can destroy it: + + app->destroy_session + +=head2 Sessions and logging in + +A common requirement is to check the user is logged in, and, if not, require +them to log in before continuing. + +This can easily be handled using a before hook to check their session: + + use Dancer2; + set session => "Simple"; + + hook before => sub { + if (!session('user') && request->path !~ m{^/login}) { + forward '/login', { requested_path => request->path }; + } + }; + + get '/' => sub { return "Home Page"; }; + + get '/secret' => sub { return "Top Secret Stuff here"; }; + + get '/login' => sub { + # Display a login page; the original URL they requested is available as + # query_parameters->get('requested_path'), so could be put in a hidden field in the form + template 'login', { path => query_parameters->get('requested_path') }; + }; + + post '/login' => sub { + # Validate the username and password they supplied + if (body_parameters->get('user') eq 'bob' && body_parameters->get('pass') eq 'letmein') { + session user => body_parameters->get('user'); + redirect body_parameters->get('path') || '/'; + } else { + redirect '/login?failed=1'; + } + }; + + dance(); + +Here is what the corresponding C<login.tt> file should look like. You should +place it in a directory called C<views/>: + + <html> + <head> + <title>Session and logging in</title> + </head> + <body> + <form action='/login' method='POST'> + User Name : <input type='text' name='user'/> + Password: <input type='password' name='pass' /> + + <!-- Put the original path requested into a hidden + field so it's sent back in the POST and can be + used to redirect to the right page after login --> + <input type='hidden' name='path' value='<% path %>'/> + + <input type='submit' value='Login' /> + </form> + </body> + </html> + +Of course, you'll probably want to validate your users against a database +table, or maybe via IMAP/LDAP/SSH/POP3/local system accounts via PAM etc. +L<Authen::Simple> is probably a good starting point here! + +A simple working example of handling authentication against a database table +yourself (using L<Dancer2::Plugin::Database> which provides the C<database> +keyword, and L<Crypt::SaltedHash> to handle salted hashed passwords (well, +you wouldn't store your users passwords in the clear, would you?)) follows: + + post '/login' => sub { + my $user_value = body_parameters->get('user'); + my $pass_value = body_parameters->get('pass'); + + my $user = database->quick_select('users', + { username => $user_value } + ); + if (!$user) { + warning "Failed login for unrecognised user $user_value"; + redirect '/login?failed=1'; + } else { + if (Crypt::SaltedHash->validate($user->{password}, $pass_value)) + { + debug "Password correct"; + # Logged in successfully + session user => $user; + redirect body_parameters->get('path') || '/'; + } else { + debug("Login failed - password incorrect for " . $user_value); + redirect '/login?failed=1'; + } + } + }; + +=head3 Retrieve complete hash stored in session + +Get complete hash stored in session: + + my $hash = session; + +=head2 Writing a session engine + +In Dancer 2, a session backend consumes the role +L<Dancer2::Core::Role::SessionFactory>. + +The following example using the Redis session demonstrates how session +engines are written in Dancer 2. + +First thing to do is to create the class for the session engine, +we'll name it C<Dancer2::Session::Redis>: + + package Dancer2::Session::Redis; + use Moo; + with 'Dancer2::Core::Role::SessionFactory'; + +we want our backend to have a handle over a Redis connection. +To do that, we'll create an attribute C<redis> + + use JSON; + use Redis; + use Dancer2::Core::Types; # brings helper for types + + has redis => ( + is => 'rw', + isa => InstanceOf['Redis'], + lazy => 1, + builder => '_build_redis', + ); + +The lazy attribute says to Moo that this attribute will be +built (initialized) only when called the first time. It means that +the connection to Redis won't be opened until necessary. + + sub _build_redis { + my ($self) = @_; + Redis->new( + server => $self->server, + password => $self->password, + encoding => undef, + ); + } + +Two more attributes, C<server> and C<password> need to be created. +We do this by defining them in the config file. Dancer2 passes anything +defined in the config to the engine creation. + + # config.yml + ... + engines: + session: + Redis: + server: foo.mydomain.com + password: S3Cr3t + +The server and password entries are now passed to the constructor +of the Redis session engine and can be accessed from there. + + has server => (is => 'ro', required => 1); + has password => (is => 'ro'); + +Next, we define the subroutine C<_retrieve> which will return a session +object for a session ID it has passed. Since in this case, sessions are +going to be stored in Redis, the session ID will be the key, the session the value. +So retrieving is as easy as doing a get and decoding the JSON string returned: + + sub _retrieve { + my ($self, $session_id) = @_; + my $json = $self->redis->get($session_id); + my $hash = from_json( $json ); + return bless $hash, 'Dancer2::Core::Session'; + } + +The C<_flush> method is called by Dancer when the session needs to be stored in +the backend. That is actually a write to Redis. The method receives a C<Dancer2::Core::Session> +object and is supposed to store it. + + sub _flush { + my ($self, $session) = @_; + my $json = encode_json( { %{ $session } } ); + $self->redis->set($session->id, $json); + } + +For the C<_destroy> method which is supposed to remove a session from the backend, +deleting the key from Redis is enough. + + sub _destroy { + my ($self, $session_id) = @_; + $self->redis->del($session_id); + } + +The C<_sessions> method which is supposed to list all the session IDs currently +stored in the backend is done by listing all the keys that Redis has. + + sub _sessions { + my ($self) = @_; + my @keys = $self->redis->keys('*'); + return \@keys; + } + +The session engine is now ready. + +=head3 The Session keyword + +Dancer2 maintains two session layers. + +The first layer, L<Dancer2::Core::Session> provides a session object +which represents the current session. You can read from it as many +times as you want, and write to it as many times as you want. + +The second layer is the session engine (L<Dancer2::Session::Simple> +is one example), which is used in order to implement the reading and +writing from the actual storage. This is read only once, when a request +comes in (using a cookie whose value is C<dancer.session> by default). +At the end of a request, all the data you've written will be flushed +to the engine itself, which will do the actual write to the storage +(whether it's in a hash in memory, in Memcache, or in a database). + +=head1 TEMPLATES + +Returning plain content is all well and good for examples or trivial apps, +but soon you'll want to use templates to maintain separation between your +code and your content. Dancer2 makes this easy. + +Your route handlers can use the L<template|Dancer2::Manual/template> keyword +to render templates. + +=head2 Views + +In Dancer2, a file which holds a template is called a I<view>. Views are +located in the C<appdir/views> directory. + +You can change this location by changing the setting 'views'. For instance +if your templates are located in the 'templates' directory, do the +following: + + set views => path( app->location , 'templates' ); + +By default, the internal template engine L<Dancer2::Template::Simple> is +used, but you may want to upgrade to L<Template +Toolkit|http://www.template-toolkit.org/>. If you do so, you have to enable +this engine in your settings as explained in +L<Dancer2::Template::TemplateToolkit> and you'll also have to install the +L<Template> module. + +In order to render a view, just call the +L<template|Dancer2::Manual/template> keyword at the end of the action by +giving the view name and the HASHREF of tokens to interpolate in the view +(note that for convenience, the request, session, params and vars are +automatically accessible in the view, named C<request>, C<session>, C<params>, +and C<vars>) - for example: + + hook before => sub { var time => scalar(localtime) }; + + get '/hello/:name' => sub { + my $name = route_parameters->get('name'); + template 'hello.tt', { name => $name }; + }; + +The template C<hello.tt> could contain, for example: + + <p>Hi there, [% name %]!</p> + <p>You're using [% request.user_agent %]</p> + [% IF session.username %] + <p>You're logged in as [% session.username %]</p> + [% END %] + It's currently [% vars.time %] + +For a full list of the tokens automatically added to your template (like +C<session>, C<request>, and C<vars>, refer to +L<Dancer2::Core::Role::Template>). + +By default, views use a F<.tt> extension. This can be overridden by setting +the C<extension> attribute in the template engine configuration: + + set engines => { + template => { + template_toolkit => { + extension => 'foo', + }, + }, + }; + +=head2 Layouts + +A layout is a special view, located in the F<layouts> directory (inside the +views directory) which must have a token named C<content>. That token marks +the place where to render the action view. This lets you define a global +layout for your actions, and have each individual view contain only +specific content. This is a good thing and helps avoid lots of needless +duplication of HTML. :) + +For example, the layout F<views/layouts/main.tt>: + + <html> + <head>...</head> + <body> + <div id="header"> + ... + </div> + + <div id="content"> + [% content %] + </div> + + </body> + </html> + +You can tell your app which layout to use with C<layout: name> in the config +file, or within your code: + + set layout => 'main'; + +You can control which layout to use (or whether to use a layout at all) for +a specific request without altering the layout setting by passing an options +hashref as the third param to the template keyword: + + template 'index.tt', {}, { layout => undef }; + +If your application is not mounted under root (C</>), you can use a +C<before_template_render> hook instead of hardcoding the path into your +application for your CSS, images and JavaScript: + + hook before_template_render => sub { + my $tokens = shift; + $tokens->{uri_base} = request->base->path; + }; + +Then in your layout, modify your CSS inclusion as follows: + + <link rel="stylesheet" href="[% uri_base %]/css/style.css" /> + +From now on you can mount your application wherever you want, without any +further modification of the CSS inclusion. + +=head2 Encoding + +If you use L<Plack> and have a Unicode problem with your Dancer2 +application, don't forget to check if you have set your template engine to +use Unicode, and set the default charset to UTF-8. So, if you are using +template toolkit, your config file will look like this: + + charset: UTF-8 + engines: + template: + template_toolkit: + ENCODING: utf8 + +=head2 Default Template Variables + +Every template knows about the following variables, which are provided by +L<Dancer2::Core::Role::Template>. Some are similar to the keywords you can +use in the Perl part of your Dancer2 application. + +=over 4 + +=item * B<perl_version> + +Current version of perl, effectively +L<C<$^V>|http://perldoc.perl.org/perlvar.html#%24%5eV>. + +=item * B<dancer_version> + +Current version of Dancer2, effectively C<< Dancer2->VERSION >>. + +=item * B<settings> + +A hash of the application configuration. This is like +the L<config|Dancer2::Manual/config> keyword. + +=item * B<request> + +The current request object. This is like the L<request|Dancer2::Manual/request> keyword. + +=item * B<params> + +A hash reference of all the parameters. + +Currently the equivalent of C<< $request->params >>, and like the +L<params|Dancer2::Manual/params> keyword. + +=item * B<vars> + +The list of request variables, which is what you would get if you +called the L<vars|Dancer2::Manual/vars> keyword. + +=item * B<session> + +The current session data, if a session exists. This is like +the L<session|Dancer2::Manual/session> keyword. + +=back + +=head1 STATIC FILES + +=head2 Static Directory + +Static files are served from the F<./public> directory. You can specify a +different location by setting the C<public_dir> option: + + set public_dir => path( app->location , 'static' ); + +When you modify default public_dir you have to set C<static_handler> option. + + set static_handler => true; + +Note that the public directory name is not included in the URL. A file +F<./public/css/style.css> is made available as +L<http://example.com/css/style.css>. + +=head2 Static File from a Route Handler + +It's possible for a route handler to send a static file, as follows: + + get '/download/*' => sub { + my ($file) = splat; + + send_file $file; + }; + +Or even if you want your index page to be a plain old F<index.html> file, +just do: + + get '/' => sub { + send_file '/index.html' + }; + +=head1 FILE UPLOADS + +Files are uploaded in Dancer2 using the class L<Dancer2::Core::Request::Upload>. +The objects are accessible within the route handlers using the C<upload> +keyword: + + post '/upload' => sub { + my $upload = upload('file_input_name'); # upload object + $upload->copy_to('Uploads/'); + }; + +=head1 CONFIGURATION + +=head2 Configuration and environments + +Configuring a Dancer2 application can be done in many ways. The easiest one +(and maybe the dirtiest) is to put all your settings statements at the top +of your script, before calling the C<dance()> method. + +Other ways are possible: for example, you can define all your settings in the file +C<appdir/config.yml>. For this, you must have installed the L<YAML> module, and +of course, write the config file in YAML. + +That's better than the first option, but it's still not perfect as you can't +switch easily from an environment to another without rewriting the config +file. + +A better solution is to have one F<config.yml> file with default global +settings, like the following: + + # appdir/config.yml + logger: 'file' + layout: 'main' + +And then write as many environment files as you like in +C<appdir/environments>. That way, the appropriate environment config file +will be loaded according to the running environment (if none is specified, +it will be 'development'). + +You can change the running environment when starting your app using the +C<plackup> command's C<--env> or C<--E> switch: + + plackup -E production bin/app.psgi + +Altenatively, you can set the +L<C<DANCER_ENVIRONMENT>|https://metacpan.org/pod/Dancer2::Config#DANCER_ENVIRONMENT> +environment variable in the shell or in your web server's configuration file. + +Typically, you'll want to set the following values in a development config +file: + + # appdir/environments/development.yml + log: 'debug' + startup_info: 1 + show_errors: 1 + +And in a production one: + + # appdir/environments/production.yml + log: 'warning' + startup_info: 0 + show_errors: 0 + +Please note that you are not limited to writing configuration files in YAML. +Dancer2 supports any file format that is supported by L<Config::Any>, such +as JSON, XML, INI files, and Apache-style config files. See the Dancer2 +L<configuration guide|https://metacpan.org/pod/Dancer2::Config#MANIPULATING-SETTINGS-VIA-CONFIGURATION-FILES> +for more information. + +=head2 Accessing configuration information + +A Dancer2 application can use the C<config> keyword to easily access the +settings within its config file, for instance: + + get '/appname' => sub { + return "This is " . config->{appname}; + }; + +This makes keeping your application's settings all in one place simple and +easy - you shouldn't need to worry about implementing all that yourself. :) + +=head2 Settings + +It's possible to change almost every parameter of the application via the +settings mechanism. + +A setting is a key/value pair assigned by the keyword B<set>: + + set setting_name => 'setting_value'; + +More usefully, settings can be defined in a configuration file. +Environment-specific settings can also be defined in environment-specific +files (for instance, you do not want to show error stacktraces in +production, and might want extra logging in development). + +=head2 Serializers + +When writing a webservice, data serialization/deserialization is a common +issue to deal with. Dancer2 can automatically handle that for you, via a +serializer. + +When setting up a serializer, a new behaviour is authorized for any route +handler you define: any non-scalar response will be rendered as a serialized +string, via the current serializer. + +Here is an example of a route handler that will return a hashref: + + use Dancer2; + set serializer => 'JSON'; + + get '/user/:id/' => sub { + { foo => 42, + number => 100234, + list => [qw(one two three)], + } + }; + +Dancer2 will render the response via the current serializer. + +Hence, with the JSON serializer set, the route handler above would result in +a content like the following: + + {"number":100234,"foo":42,"list":["one","two","three"]} + +If you send a value which is validated serialized data, but is not in the +form a key and value pair (such as a serialized string or a JSON array), the +data will not be available in C<params> but will be available in +C<< request->data >>. + +The following serializers are available, be aware they dynamically depend on +Perl modules you may not have on your system. + +=over 4 + +=item * B<JSON> + +Requires L<JSON>. + +=item * B<YAML> + +Requires L<YAML>, + +=item * B<XML> + +Requires L<XML::Simple>. + +=item * B<Mutable> + +Will try to find the appropriate serializer using the B<Content-Type> and +B<Accept-type> header of the request. + +=back + +=head2 Importing using Appname + +An app in Dancer2 uses the class name (defined by the C<package> function) to +define the App name. Thus separating the App to multiple files, actually means +creating multiple applications. This means that any engine defined in an application, +because the application is a complete separate scope, will not be available to a +different application: + + package MyApp::User { + use Dancer2; + set serializer => 'JSON'; + get '/view' => sub {...}; + } + + package MyApp::User::Edit { + use Dancer2; + get '/edit' => sub {...}; + } + +These are two different Dancer2 Apps. They have different scopes, contexts, +and thus different engines. While C<MyApp::User> has a serializer defined, +C<MyApp::User::Edit> will not have that configuration. + +By using the import option C<appname>, we can ask Dancer2 to extend an +App without creating a new one: + + package MyApp::User { + use Dancer2; + set serializer => 'JSON'; + get '/view' => sub {...}; + } + + package MyApp::User::Edit { + use Dancer2 appname => 'MyApp::User'; # extending MyApp::User + get '/edit' => sub {...}; + } + +The import option C<appname> allows you to seamlessly extend Dancer2 Apps +without creating unnecessary additional applications or repeat any definitions. +This allows you to spread your application routes across multiple files and allow +ease of mind when developing it, and accommodate multiple developers working +on the same codebase. + + # app.pl + use MyApp::User; + use MyApp::User::Edit; + + # single application composed of routes provided in multiple files + MyApp::User->to_app; + +This way only one class needs to be loaded while creating an app: + + # app.pl: + use MyApp::User; + MyApp::User->to_app; + +=head1 LOGGING + +=head2 Configuring logging + +It's possible to log messages generated by the application and by Dancer2 +itself. + +To start logging, select the logging engine you wish to use with the +C<logger> setting; Dancer2 includes built-in log engines named C<file> and +C<console>, which log to a logfile and to the console respectively. + +To enable logging to a file, add the following to your config file: + + logger: 'file' + +Then you can choose which kind of messages you want to actually log: + + log: 'core' # will log debug, info, warnings, errors, + # and messages from Dancer2 itself + log: 'debug' # will log debug, info, warning and errors + log: 'info' # will log info, warning and errors + log: 'warning' # will log warning and errors + log: 'error' # will log only errors + +If you're using the C<file> logging engine, a directory C<appdir/logs> will +be created and will host one logfile per environment. The log message +contains the time it was written, the PID of the current process, the +message and the caller information (file and line). + +=head2 Logging your own messages + +Just call L<debug|https://metacpan.org/pod/Dancer2::Manual#debug>, +L<info|https://metacpan.org/pod/Dancer2::Manual#info>, +L<warning|https://metacpan.org/pod/Dancer2::Manual#warning> or +L<error|https://metacpan.org/pod/Dancer2::Manual#error> with your message: + + debug "This is a debug message from my app."; + +=head1 TESTING + +=head2 Using Plack::Test + +L<Plack::Test> receives a common web request (using standard L<HTTP::Request> +objects), fakes a web server in order to create a proper PSGI request, and sends it +to the web application. When the web application returns a PSGI response +(which Dancer applications do), it will then convert it to a common web response +(as a standard L<HTTP::Response> object). + +This allows you to then create requests in your test, create the code reference +for your web application, call them, and receive a response object, which can +then be tested. + +=head3 Basic Example + +Assuming there is a web application: + + # MyApp.pm + package MyApp; + use Dancer2; + get '/' => sub {'OK'}; + 1; + +The following test I<base.t> is created: + + # base.t + use strict; + use warnings; + use Test::More tests => 2; + use Plack::Test; + use HTTP::Request; + use MyApp; + +Creating a coderef for the application using the C<to_app> keyword: + + my $app = MyApp->to_app; + +Creating a test object from L<Plack::Test> for the application: + + my $test = Plack::Test->create($app); + +Creating the first request object and sending it to the test object +to receive a response: + + my $request = HTTP::Request->new( GET => '/' ); + my $response = $test->request($request); + +It can now be tested: + + ok( $response->is_success, '[GET /] Successful request' ); + is( $response->content, 'OK', '[GET /] Correct content' ); + +=head3 Putting it together + + # base.t + use strict; + use warnings; + use Test::More; + use Plack::Test; + use HTTP::Request::Common; + use MyApp; + + my $test = Plack::Test->create( MyApp->to_app ); + my $response = $test->request( GET '/' ); + + ok( $response->is_success, '[GET /] Successful request' ); + is( $response->content, 'OK', '[GET /] Correct content' ); + + done_testing(); + +=head3 Subtests + +Tests can be separated using L<Test::More>'s C<subtest> functionality, +thus creating multiple self-contained tests that don't overwrite each other. + +Assuming we have a different app that has two states we want to test: + + # MyApp.pm + package MyApp; + use Dancer2; + set serializer => 'JSON'; + + get '/:user' => sub { + my $user = route_parameters->get('user'); + + $user and return { user => $user }; + + return {}; + }; + + 1; + +This is a contrived example of a route that checks for a user +parameter. If it exists, it returns it in a hash with the key +'user'. If not, it returns an empty hash + + # param.t + use strict; + use warnings; + use Test::More; + use Plack::Test; + use HTTP::Request::Common; + use MyApp; + + my $test = Plack::Test->create( MyApp->to_app ); + + subtest 'A empty request' => sub { + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content '{}', 'Empty response back' ); + }; + + subtest 'Request with user' => sub { + my $res = $test->request( GET '/?user=sawyer_x' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content '{"user":"sawyer_x"}', 'Empty response back' ); + }; + + done_testing(); + +=head3 Cookies + +To handle cookies, which are mostly used for maintaining sessions, +the following modules can be used: + +=over 4 + +=item * L<Test::WWW::Mechanize::PSGI> + +=item * L<LWP::Protocol::PSGI> + +=item * L<HTTP::Cookies> + +=back + +Taking the previous test, assuming it actually creates and uses +cookies for sessions: + + # ... all the use statements + use HTTP::Cookies; + + my $jar = HTTP::Cookies->new; + my $test = Plack::Test->create( MyApp->to_app ); + + subtest 'A empty request' => sub { + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content '{}', 'Empty response back' ); + $jar->extract_cookies($res); + ok( $jar->as_string, 'We have cookies!' ); + }; + + subtest 'Request with user' => sub { + my $req = GET '/?user=sawyer_x'; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok( $res->is_success, 'Successful request' ); + is( $res->content '{"user":"sawyer_x"}', 'Empty response back' ); + $jar->extract_cookies($res); + + ok( ! $jar->as_string, 'All cookies deleted' ); + }; + + done_testing(); + +Here a cookie jar is created, all requests and responses, existing +cookies, as well as cookies that were deleted by the response, are checked. + +=head3 Accessing the configuration file + +By importing Dancer2 in the command line scripts, there is full +access to the configuration using the imported keywords: + + use strict; + use warnings; + use Test::More; + use Plack::Test; + use HTTP::Request::Common; + use MyApp; + use Dancer2; + + my $appname = config->{'appname'}; + diag "Testing $appname"; + + # ... + +=head1 PACKAGING + +=head2 Carton + +=head3 What it does + +L<Carton> sets up a local copy of your project prerequisites. You only +need to define them in a file and ask Carton to download all of them +and set them up. +When you want to deploy your app, you just carry the git clone and ask +Carton to set up the environment again and you will then be able to run it. + +The benefits are multifold: + +=over 4 + +=item * Local Directory copy + +By putting all the dependencies in a local directory, you can make +sure they aren't updated by someone else by accident and their versions +locked to the version you picked. + +=item * Sync versions + +Deciding which versions of the dependent modules your project needs +allows you to sync this with other developers as well. Now you're all +using the same version and they don't change unless you want update the +versions you want. When updated everyone again uses the same new version +of everything. + +=item * Carry only the requirement, not bundled modules + +Instead of bundling the modules, you only actually bundle the requirements. +Carton builds them for you when you need it. + +=back + +=head3 Setting it up + +First set up a new app: + + $ dancer2 -a MyApp + ... + +Delete the files that are not needed: + + $ rm -f Makefile.PL MANIFEST MANIFEST.SKIP + +Create a git repo: + + $ git init && git add . && git commit -m "initial commit" + +Add a requirement using the L<cpanfile> format: + + $ cat > cpanfile + requires 'Dancer2' => 0.155000; + requires 'Template' => 0; + recommends 'URL::Encode::XS' => 0; + recommends 'CGI::Deurl::XS' => 0; + recommends 'HTTP::Parser::XS' => 0; + +Ask carton to set it up: + + $ carton install + Installing modules using [...] + Successfully installed [...] + ... + Complete! Modules were install into [...]/local + +Now we have two files: I<cpanfile> and I<cpanfile.snapshot>. We +add both of them to our Git repository and we make sure we don't +accidentally add the I<local/> directory Carton created which holds +the modules it installed: + + $ echo local/ >> .gitignore + $ git add .gitignore cpanfile cpanfile.snapshot + $ git commit -m "Start using carton" + +When we want to update the versions on the production machine, +we simply call: + + $ carton install --deployment + +By using --deployment we make sure we only install the modules +we have in our cpanfile.snapshot file and do not fallback to querying +the CPAN. + +=head2 FatPacker + +L<App::FatPacker> (using its command line interface, L<fatpack>) packs +dependencies into a single file, allowing you to carry a single file +instead of a directory tree. + +As long as your application is pure-Perl, you could create a single +file with your application and all of Dancer2 in it. + +The following example will demonstrate how this can be done: + +Assuming we have an application in I<lib/MyApp.pm>: + + package MyApp; + use Dancer2; + get '/' => sub {'OK'}; + 1; + +And we have a handler in I<bin/app.pl>: + + use strict; + use warnings; + use FindBin; + use lib "$FindBin::Bin/../lib"; + use MyApp; + + MyApp->to_app; + +To fatpack it, we begin by tracing the script: + + $ fatpack trace bin/app.pl + +This creates a I<fatpacker.trace> file. From this we create the packlists: + + $ fatpack packlists-for `cat fatpacker.trace` > packlists + +The packlists are stored in a file called I<packlists>. + +Now we create the tree using the following command: + + $ fatpack tree `cat packlists` + +The tree is created under the directory I<fatlib>. + +Now we create a file containing the dependency tree, and add our script to it, +using the following command: + + $ (fatpack file; cat bin/app.pl) > myapp.pl + +This creates a file called I<myapp.pl> with everything in it. Dancer2 uses +L<MIME::Types> which has a database of all MIME types and helps translate those. +The small database file containing all of these types is a binary and therefore +cannot be fatpacked. Hence, it needs to be copied to the current directory so our +script can find it: + + $ cp fatlib/MIME/types.db . + +=head1 MIDDLEWARES + +=head2 Plack middlewares + +If you want to use Plack middlewares, you need to enable them using +L<Plack::Builder> as such: + + # in app.psgi or any other handler + use MyApp; + use Plack::Builder; + + builder { + enable 'Deflater'; + enable 'Session', store => 'File'; + enable 'Debug', panels => [ qw<DBITrace Memory Timer> ]; + MyApp->to_app; + }; + +The nice thing about this setup is that it will work seamlessly through +Plack or through the internal web server. + + # load dev web server (without middlewares) + perl -Ilib app.psgi + + # load plack web server (with middlewares) + plackup -I lib app.psgi + +You do not need to provide different files for either server. + +=head3 Path-based middlewares + +If you want to set up a middleware for a specific path, you can do that using +L<Plack::Builder> which uses L<Plack::App::URLMap>: + + # in your app.psgi or any other handler + use MyApp; + use Plack::Builder; + + my $special_handler = sub { ... }; + + builder { + mount '/special' => $special_handler; + mount '/' => MyApp->to_app; + }; + +=head3 Removing default middlewares + +By default, a Dancer2 app is automatically wrapped with the following middleware + +=over 4 + +=item * L<Plack::Middleware::FixMissingBodyInRedirect> + +=item * L<Plack::Middleware::Head> + +=back + +You can configure the setting C<no_default_middleware> to a true value to stop your +Dancer2 app being wrapped with these default middleware layers. + + # in you Dancer2 app or config.yml + package MyApp; + use Dancer2 + + set no_default_middleware => true; + +This is necessary if you need to add eTag or ContentMD5 headers to +C<HEAD> requests, and you are encouraged to manually add those default +middleware back into your PSGI stack. + +=head3 Running on Perl web servers with plackup + +A number of Perl web servers supporting PSGI are available on CPAN: + +=over 4 + +=item * L<Starman> + +C<Starman> is a high performance web server, with support for preforking, +signals, multiple interfaces, graceful restarts and dynamic worker pool +configuration. + +=item * L<Twiggy> + +C<Twiggy> is an C<AnyEvent> web server, it's light and fast. + +=item * L<Corona> + +C<Corona> is a C<Coro> based web server. + +=back + +To start your application, just run plackup (see L<Plack> and specific +servers above for all available options): + + $ plackup bin/app.psgi + $ plackup -E deployment -s Starman --workers=10 -p 5001 -a bin/app.psgi + +As you can see, the scaffolded Perl script for your app can be used as a +PSGI startup file. + +=head4 Enabling content compression + +Content compression (gzip, deflate) can be easily enabled via a Plack +middleware (see L<Plack/Plack::Middleware>): L<Plack::Middleware::Deflater>. +It's a middleware to encode the response body in gzip or deflate, based on the +C<Accept-Encoding> HTTP request header. + +Enable it as you would enable any Plack middleware. First you need to +install L<Plack::Middleware::Deflater>, then in the handler (usually +F<app.psgi>) edit it to use L<Plack::Builder>, as described above: + + use Dancer2; + use MyApp; + use Plack::Builder; + + builder { + enable 'Deflater'; + MyApp->to_app; + }; + +To test if content compression works, trace the HTTP request and response +before and after enabling this middleware. Among other things, you should +notice that the response is gzip or deflate encoded, and contains a header +C<Content-Encoding> set to C<gzip> or C<deflate>. + +=head3 Running multiple apps with Plack::Builder + +You can use L<Plack::Builder> to mount multiple Dancer2 applications on a +L<PSGI> webserver like L<Starman>. + +Start by creating a simple app.psgi file: + + use OurWiki; # first app + use OurForum; # second app + use Plack::Builder; + + builder { + mount '/wiki' => OurWiki->to_app; + mount '/forum' => OurForum->to_app; + }; + +and now use L<Starman> + + plackup -a app.psgi -s Starman + +Currently this still demands the same appdir for both (default circumstance) +but in a future version this will be easier to change while staying very +simple to mount. + +=head3 Running from Apache with Plack + +You can run your app from Apache using PSGI (Plack), with a config like the +following: + + <VirtualHost myapp.example.com> + ServerName www.myapp.example.com + ServerAlias myapp.example.com + DocumentRoot /websites/myapp.example.com + + <Directory /home/myapp/myapp> + AllowOverride None + Order allow,deny + Allow from all + </Directory> + + <Location /> + SetHandler perl-script + PerlResponseHandler Plack::Handler::Apache2 + PerlSetVar psgi_app /websites/myapp.example.com/app.psgi + </Location> + + ErrorLog /websites/myapp.example.com/logs/error_log + CustomLog /websites/myapp.example.com/logs/access_log common + </VirtualHost> + +To set the environment you want to use for your application (production or +development), you can set it this way: + + <VirtualHost> + ... + SetEnv DANCER_ENVIRONMENT "production" + ... + </VirtualHost> + +=head1 PLUGINS + +=head2 Writing a plugin + +See L<Dancer2::Plugin/Writing the plugin> for information on how to author +a new plugin for Dancer2. + +=head1 EXPORTS + +By default, C<use Dancer2> exports all the DSL keywords and sets up the +webapp under the name of the current package. The following tags control +exports and webapp namespace. + +=over 4 + +=item * B<!keyword> + +If you want to prevent Dancer2 from exporting specific keywords (perhaps you +plan to implement them yourself in a different way, or they clash with +another module you're loading), you can simply exclude them: + + use Test::More; + use Dancer2 qw(!pass); + +The above would import all keywords as usual, with the exception of C<pass>. + +=item * B<appname> + +A larger application may split its source between several packages to aid +maintainability. Dancer2 will create a separate application for each +package, each having separate hooks, config and/or engines. You can force +Dancer2 to collect the route and hooks into a single application with the +C<appname> tag; e.g. + + package MyApp; + use Dancer2; + get '/foo' => sub {...}; + + package MyApp::Private; + use Dancer2 appname => MyApp; + get '/bar' => sub {...}; + +The above would add the C<bar> route to the MyApp application. Dancer2 will +I<not> create an application with the name C<MyApp::Private>. + +=item * B<:nopragmas> + +By default L<Dancer2> will import three pragmas: L<strict>, L<warnings>, +and L<utf8>. If you require control over the imported pragmas, you can add +B<:nopragmas> to the importing flags, in which case Dancer2 will not import +any pragmas: + + use strict; + use warnings; + no warnings 'experimental::smartmatch'; # for example... + use Dancer2 ':nopragmas'; # do not touch the existing pragmas + +This way importing C<Dancer2> does not change the existing pragmas setup +you have. + +=back + +When you C<use Dancer2>, you get an C<import> method added into the current +package. This B<will> override previously declared import methods from other +sources, such as L<Exporter>. Dancer2 applications support the following +tags on import: + +=over 4 + +=item * B<with> + +The C<with> tag allows an app to pass one or more config entries to another +app, when it C<use>s it. + + package MyApp; + use Dancer2; + + BEGIN { set session => 'YAML' }; + use Blog with => { session => engine('session') }; + +In this example, the session engine is passed to the C<Blog> app. That way, +anything done in the session will be shared between both apps. + +Anything that is defined in the config entry can be passed that way. If we +want to pass the whole config object, it can be done like so: + + use SomeApp with => { %{config()} }; + +=back + +=head1 DSL KEYWORDS + +Dancer2 provides you with a DSL (Domain-Specific Language) which makes +implementing your web application trivial. + +For example, take the following example: + + use Dancer2; + + get '/hello/:name' => sub { + my $name = route_parameters->get('name'); + }; + dance; + +C<get> and C<route_parameters> are keywords provided by Dancer2. + +This document lists all keywords provided by Dancer2. It does not cover +additional keywords which may be provided by loaded plugins; see the +documentation for plugins you use to see which additional keywords they make +available to you. + +=head2 any + +Defines a route for multiple HTTP methods at once: + + any ['get', 'post'] => '/myaction' => sub { + # code + }; + +Or even, a route handler that would match any HTTP methods: + + any '/myaction' => sub { + # code + }; + +=head2 cookies + +Accesses cookies values, it returns a hashref of L<Dancer2::Core::Cookie> +objects: + + get '/some_action' => sub { + my $cookie = cookies->{name}; + return $cookie->value; + }; + +In case you have stored something other than a scalar in your cookie: + + get '/some_action' => sub { + my $cookie = cookies->{oauth}; + my %values = $cookie->value; + return ($values{token}, $values{token_secret}); + }; + +=head2 cookie + +Accesses a cookie value (or sets it). Note that this method will eventually +be preferred over C<set_cookie>. + + cookie lang => "fr-FR"; # set a cookie and return its value + cookie lang => "fr-FR", expires => "2 hours"; # extra cookie info + cookie "lang" # return a cookie value + +If your cookie value is a key/value URI string, like + + token=ABC&user=foo + +C<cookie> will only return the first part (C<token=ABC>) if called in scalar +context. Use list context to fetch them all: + + my @values = cookie "name"; + +=head2 config + +Accesses the configuration of the application: + + get '/appname' => sub { + return "This is " . config->{appname}; + }; + +=head2 content + +Sets the content for the response. This B<only> works within a delayed +response. + +This will crash: + + get '/' => sub { + # THIS WILL CRASH + content 'Hello, world!'; + }; + +But this will work just fine: + + get '/' => sub { + delayed { + content 'Hello, world!'; + ... + }; + }; + +=head2 content_type + +Sets the B<content-type> rendered, for the current route handler: + + get '/cat/:txtfile' => sub { + content_type 'text/plain'; + + # here we can dump the contents of route_parameters->get('txtfile') + }; + +You can use abbreviations for content types. For instance: + + get '/svg/:id' => sub { + content_type 'svg'; + + # here we can dump the image with id route_parameters->get('id') + }; + +Note that if you want to change the default content-type for every route, +it is easier to change the C<content_type> setting instead. + +=head2 dance + +Alias for the C<start> keyword. + +=head2 dancer_version + +Returns the version of Dancer. If you need the major version, do something +like: + + int(dancer_version); + +=head2 debug + +Logs a message of debug level: + + debug "This is a debug message"; + +See L<Dancer2::Core::Role::Logger> for details on how to configure where log +messages go. + +=head2 decode_json ($string) + +Deserializes a JSON structure from an UTF-8 binary string. + +=head2 dirname + +Returns the dirname of the path given: + + my $dir = dirname($some_path); + +=head2 encode_json ($structure) + +Serializes a structure to a UTF-8 binary JSON string. + +Calling this function will B<not> trigger the serialization's hooks. + +=head2 engine + +Given a namespace, returns the current engine object + + my $template_engine = engine 'template'; + my $html = $template_engine->apply_renderer(...); + $template_engine->apply_layout($html); + +=head2 error + +Logs a message of error level: + + error "This is an error message"; + +See L<Dancer2::Core::Role::Logger> for details on how to configure where log +messages go. + +=head2 false + +Constant that returns a false value (0). + +=head2 forward + +Runs an "internal redirect" of the current route to another route. More +formally; when C<forward> is executed, the current dispatch of the route is +aborted, the request is modified (altering query params or request method), +and the modified request following a new route is dispatched again. Any +remaining code (route and hooks) from the current dispatch will never be run +and the modified route's dispatch will execute hooks for the new route normally. + +It effectively lets you chain routes together in a clean manner. + + get '/demo/articles/:article_id' => sub { + + # you'll have to implement this next sub yourself :) + change_the_main_database_to_demo(); + + forward "/articles/" . route_parameters->get('article_id'); + }; + +In the above example, the users that reach I</demo/articles/30> will +actually reach I</articles/30> but we've changed the database to demo +before. + +This is pretty cool because it lets us retain our paths and offer a demo +database by merely going to I</demo/...>. + +You'll notice that in the example we didn't indicate whether it was B<GET> +or B<POST>. That is because C<forward> chains the same type of route the +user reached. If it was a B<GET>, it will remain a B<GET> (but if you do +need to change the method, you can do so; read on below for details.) + +Also notice that C<forward> only redirects to a new route. It does not redirect +the requests involving static files. This is because static files are handled +before L<Dancer2> tries to match the request to a route - static files take +higher precedence. + +This means that you will not be able to C<forward> to a static file. If you +wish to do so, you have two options: either redirect (asking the browser to +make another request, but to a file path instead) or use C<send_file> to +provide a file. + +B<WARNING:> Any code after a C<forward> is ignored, until the end of the +route. It's not necessary to use C<return> with C<forward> anymore. + + get '/foo/:article_id' => sub { + if ($condition) { + forward "/articles/" . route_parameters->get('article_id'); + # The following code WILL NOT BE executed + do_stuff(); + } + + more_stuff(); + }; + +Note that C<forward> doesn't parse GET arguments. So, you can't use +something like: + + forward '/home?authorized=1'; + +But C<forward> supports an optional hashref with parameters to be added to +the actual parameters: + + forward '/home', { authorized => 1 }; + +Finally, you can add some more options to the C<forward> method, in a third +argument, also as a hashref. That option is currently only used to change +the method of your request. Use with caution. + + forward '/home', { auth => 1 }, { method => 'POST' }; + +=head2 from_dumper ($structure) + +Deserializes a Data::Dumper structure. + +=head2 from_json ($string, \%options) + +Deserializes a JSON structure from a string. You should probably use +C<decode_json> which expects a UTF-8 encoded binary string and +handles decoding it for you. + +=head2 from_yaml ($structure) + +Deserializes a YAML structure. + +=head2 get + +Defines a route for HTTP B<GET> requests to the given path: + + get '/' => sub { + return "Hello world"; + } + +Note that a route to match B<HEAD> requests is automatically created as well. + +=head2 halt + +Sets a response object with the content given. + +When used as a return value from a hook, this breaks the execution flow and +renders the response immediately: + + hook before => sub { + if ($some_condition) { + halt("Unauthorized"); + + # this code is not executed + do_stuff(); + } + }; + + get '/' => sub { + "hello there"; + }; + +B<WARNING:> Issuing a halt immediately exits the current route, and performs +the halt. Thus, any code after a halt is ignored, until the end of the route. +Hence, it's not necessary anymore to use C<return> with halt. + +=head2 response_headers + +Adds custom headers to response: + + get '/send/headers', sub { + response_headers 'X-Foo' => 'bar', 'X-Bar' => 'foo'; + } + +=head2 response_header + +Adds a custom header to response: + + get '/send/header', sub { + response_header 'x-my-header' => 'shazam!'; + } + +Note that it will overwrite the old value of the header, if any. To avoid +that, see L</push_response_header>. + +=head2 push_response_header + +Do the same as C<response_header>, but allow for multiple headers with the same +name. + + get '/send/header', sub { + push_response_header 'x-my-header' => '1'; + push_response_header 'x-my-header' => '2'; + # will result in two headers "x-my-header" in the response + } + +=head2 prepare_app + +You can introduce code you want to run when your app is loaded, similar to the +C<prepare_app> in L<Plack::Middleware>. + + prepare_app { + my $app = shift; + + ... # do your thing + }; + +You should not close over the App instance, since you receive it as a first +argument. If you close over it, you B<will> have a memory leak. + + my $app = app(); + + prepare_app { + do_something_with_app($app); # MEMORY LEAK + }; + +=head2 hook + +Adds a hook at some position. For example : + + hook before_serializer => sub { + my $content = shift; + ... + }; + +There can be multiple hooks assigned to a given position, and each will be +executed in order. + +See the L<HOOKS|/HOOKS> section for a list of available hooks. + +=head2 info + +Logs a message of C<info> level: + + info "This is an info message"; + +See L<Dancer2::Core::Role::Logger> for details on how to configure where log +messages go. + +=head2 mime + +Shortcut to access the instance object of L<Dancer2::Core::MIME>. You should +read the L<Dancer2::Core::MIME> documentation for full details, but the most +commonly-used methods are summarized below: + + # set a new mime type + mime->add_type( foo => 'text/foo' ); + + # set a mime type alias + mime->add_alias( f => 'foo' ); + + # get mime type for an alias + my $m = mime->for_name( 'f' ); + + # get mime type for a file (based on extension) + my $m = mime->for_file( "foo.bar" ); + + # get current defined default mime type + my $d = mime->default; + + # set the default mime type using config.yml + # or using the set keyword + set default_mime_type => 'text/plain'; + +=head2 params + +I<This method should be called from a route handler>. +It's an alias for the L<Dancer2::Core::Request params +accessor|Dancer2::Core::Request/"params($source)">. It returns a hash (in +list context) or a hash reference (in scalar context) to all defined +parameters. Check C<param> below to access quickly to a single parameter +value. + + post '/login' => sub { + # get all parameters as a single hash + my %all_parameters = params; + + // request all parmameters from a specific source: body, query, route + my %body_parameters = params('body'); + my %route_parameters = params('route'); + my %query_parameters = params('query'); + + # any $source that is not body, query, or route generates an exception + params('fake_source'); // Unknown source params "fake_source" + }; + +We now recommend using one of the specific keywords for parameters +(C<route_parameters>, C<query_parameters>, and C<body_parameters>) +instead of C<params> or C<param>. + +=head2 param + +I<This method should be called from a route handler>. +This method is an accessor to the parameters hash table. + + post '/login' => sub { + my $username = param "user"; + my $password = param "pass"; + # ... + }; + +We now recommend using one of the specific keywords for parameters +(C<route_parameters>, C<query_parameters>, and C<body_parameters>) +instead of C<params> or C<param>. + +=head2 route_parameters + +Returns a L<Hash::MultiValue> object from the route parameters. + + # /hello + get '/:foo' => sub { + my $foo = route_parameters->get('foo'); + }; + +=head2 query_parameters + +Returns a L<Hash::MultiValue> object from the request parameters. + + /?foo=hello + get '/' => sub { + my $name = query_parameters->get('foo'); + }; + + /?name=Alice&name=Bob + get '/' => sub { + my @names = query_parameters->get_all('name'); + }; + +=head2 body_parameters + +Returns a L<Hash::MultiValue> object from the body parameters. + + post '/' => sub { + my $last_name = body_parameters->get('name'); + my @all_names = body_parameters->get_all('name'); + }; + +=head2 pass + +I<This method should be called from a route handler>. +Tells Dancer2 to pass the processing of the request to the next matching +route. + +B<WARNING:> Issuing a pass immediately exits the current route, and performs +the pass. Thus, any code after a pass is ignored, until the end of the +route. Hence, it's not necessary anymore to use C<return> with pass. + + get '/some/route' => sub { + if (...) { + # we want to let the next matching route handler process this one + pass(...); + + # this code will be ignored + do_stuff(); + } + }; + +B<WARNING:> You cannot set the content before passing and have it remain, +even if you use the C<content> keyword or set it directly in the response +object. + +=head2 patch + +Defines a route for HTTP B<PATCH> requests to the given URL: + + patch '/resource' => sub { ... }; + +(C<PATCH> is a relatively new and not-yet-common HTTP verb, which is +intended to work as a "partial-PUT", transferring just the changes; please +see L<RFC5789|http://tools.ietf.org/html/rfc5789> for further details.) + +=head2 path + +Concatenates multiple paths together, without worrying about the underlying +operating system: + + my $path = path(dirname($0), 'lib', 'File.pm'); + +It also normalizes (cleans) the path aesthetically. It does not verify whether +the path exists, though. + +=head2 post + +Defines a route for HTTP B<POST> requests to the given URL: + + post '/' => sub { + return "Hello world"; + } + +=head2 prefix + +Defines a prefix for each route handler, like this: + + prefix '/home'; + +From here, any route handler is defined to /home/*: + + get '/page1' => sub {}; # will match '/home/page1' + +You can unset the prefix value: + + prefix undef; + get '/page1' => sub {}; # will match /page1 + +For a safer alternative you can use lexical prefix like this: + + prefix '/home' => sub { + ## Prefix is set to '/home' here + + get ...; + get ...; + }; + ## prefix reset to the previous version here + +This makes it possible to nest prefixes: + + prefix '/home' => sub { + ## some routes + + prefix '/private' => sub { + ## here we are under /home/private... + + ## some more routes + }; + ## back to /home + }; + ## back to the root + +B<Notice:> Once you have a prefix set, do not add a caret to the regex: + + prefix '/foo'; + get qr{^/bar} => sub { ... } # BAD BAD BAD + get qr{/bar} => sub { ... } # Good! + +=head2 del + +Defines a route for HTTP B<DELETE> requests to the given URL: + + del '/resource' => sub { ... }; + +=head2 options + +Defines a route for HTTP B<OPTIONS> requests to the given URL: + + options '/resource' => sub { ... }; + +=head2 put + +Defines a route for HTTP B<PUT> requests to the given URL: + + put '/resource' => sub { ... }; + +=head2 redirect + +Generates a HTTP redirect (302). You can either redirect to a complete +different site or within the application: + + get '/twitter', sub { + redirect 'http://twitter.com/me'; + # Any code after the redirect will not be executed. + }; + +B<WARNING:> Issuing a C<redirect> immediately exits the current route. +Thus, any code after a C<redirect> is ignored, until the end of the route. +Hence, it's not necessary anymore to use C<return> with C<redirect>. + +You can also force Dancer to return a specific 300-ish HTTP response code: + + get '/old/:resource', sub { + redirect '/new/' . route_parameters->get('resource'), 301; + }; + +=head2 request + +Returns a L<Dancer2::Core::Request> object representing the current request. + +See the L<Dancer2::Core::Request> documentation for the methods you can +call, for example: + + request->referer; # value of the HTTP referer header + request->remote_address; # user's IP address + request->user_agent; # User-Agent header value + +=head2 request_header + +Returns request header(s). + + get '/get/headers' => sub { + my $xfoo = request_header 'X-Foo'; + ... + }; + +=head2 send_as + +Allows the current route handler to return specific content types to the +client using either a specified serializer or as html. + +Any Dancer2 serializer may be used. The specified serializer class will +be loaded if required, or an error generated if the class can not be found. +Serializer configuration may be added to your apps C<engines> configuration. + +If C<html> is specified, the content will be returned assuming it is HTML with +appropriate C<Content-Type> headers and encoded using the apps configured +C<charset> (or UTF-8). + + set serializer => 'YAML'; + set template => 'TemplateToolkit'; + + # returns html (not YAML) + get '/' => sub { send_as html => template 'welcome.tt' }; + + # return json (not YAML) + get '/json' => sub { + send_as JSON => [ some => { data => 'structure' } ]; + }; + +C<send_as> uses L</send_file> to return the content immediately. You may +pass any option C<send_file> supports as an extra option. For example: + + # return json with a custom content_type header + get '/json' => sub { + send_as JSON => [ some => { data => 'structure' } ], + { content_type => 'application/json; charset=UTF-8' }, + }; + +B<WARNING:> Issuing a send_as immediately exits the current route, and +performs the C<send_as>. Thus, any code after a C<send_as> is ignored, +until the end of the route. Hence, it's not necessary to use C<return> +with C<send_as>. + + get '/some/route' => sub { + if (...) { + send_as JSON => $some_data; + + # this code will be ignored + do_stuff(); + } + }; + +=head2 send_error + +Returns a HTTP error. By default the HTTP code returned is 500: + + get '/photo/:id' => sub { + if (...) { + send_error("Not allowed", 403); + } else { + # return content + } + } + +B<WARNING:> Issuing a send_error immediately exits the current route, and +performs the C<send_error>. Thus, any code after a C<send_error> is ignored, +until the end of the route. Hence, it's not necessary anymore to use C<return> +with C<send_error>. + + get '/some/route' => sub { + if (...) { + # Something bad happened, stop immediately! + send_error(..); + + # this code will be ignored + do_stuff(); + } + }; + +=head2 send_file + +Lets the current route handler send a file to the client. Note that the path +of the file must be relative to the B<public> directory unless you use the +C<system_path> option (see below). + + get '/download/:file' => sub { + return send_file(route_parameters->get('file')); + } + +B<WARNING:> Issuing a C<send_file> immediately exits the current route, and +performs the C<send_file>. Thus, any code after a C<send_file> is ignored, +until the end of the route. Hence, it's not necessary anymore to use C<return> +with C<send_file>. + + get '/some/route' => sub { + if (...) { + # OK, send her what she wants... + send_file(...); + + # this code will be ignored + do_stuff(); + } + }; + +C<send_file> will use PSGI streaming if the server supports it (most, if +not all, do). You can explicitly disable streaming by passing +C<streaming =E<gt> 0> as an option to C<send_file>. + + get '/download/:file' => sub { + send_file( route_parameters->get('file'), streaming => 0 ); + } + +The content-type will be set depending on the current MIME types definition +(see C<mime> if you want to define your own). + +If your filename does not have an extension, you are passing in a filehandle, +or you need to force a specific mime type, you can pass it to C<send_file> +as follows: + + send_file(route_parameters->get('file'), content_type => 'image/png'); + send_file($fh, content_type => 'image/png'); + +Also, you can use your aliases or file extension names on C<content_type>, +like this: + + send_file(route_parameters->get('file'), content_type => 'png'); + +The encoding of the file or filehandle may be specified by passing both +the C<content_type> and C<charset> options. For example: + + send_file($fh, content_type => 'text/csv', charset => 'utf-8' ); + +For files outside your B<public> folder, you can use the C<system_path> +switch. Just bear in mind that its use needs caution as it can be dangerous. + + send_file('/etc/passwd', system_path => 1); + +If you have your data in a scalar variable, C<send_file> can be useful as +well. Pass a reference to that scalar, and C<send_file> will behave as if +there was a file with that contents: + + send_file( \$data, content_type => 'image/png' ); + +Note that Dancer is unable to guess the content type from the data contents. +Therefore you might need to set the C<content_type> properly. For this kind +of usage an attribute named C<filename> can be useful. It is used as the +Content-Disposition header, to hint the browser about the filename it should +use. + + send_file( \$data, content_type => 'image/png' + filename => 'onion.png' ); + +By default the Content-Disposition header uses the "attachment" type, which +triggers a "Save" dialog in some browsers. Supply a C<content_disposition> +attribute of "inline" to have the file displayed inline by the browser. + +=head2 set + +Defines a setting: + + set something => 'value'; + +You can set more than one value at once: + + set something => 'value', otherthing => 'othervalue'; + +=head2 setting + +Returns the value of a given setting: + + setting('something'); # 'value' + +=head2 session + +Provides access to all data stored in the user's session (if any). + +It can also be used as a setter to store data in the session: + + # getter example + get '/user' => sub { + if (session('user')) { + return "Hello, ".session('user')->name; + } + }; + + # setter example + post '/user/login' => sub { + ... + if ($logged_in) { + session user => $user; + } + ... + }; + +You may also need to clear a session: + + # destroy session + get '/logout' => sub { + ... + app->destroy_session; + ... + }; + +If you need to fetch the session ID being used for any reason: + + my $id = session->id; + +=head2 splat + +Returns the list of captures made from a route handler with a route pattern +which includes wildcards: + + get '/file/*.*' => sub { + my ($file, $extension) = splat; + ... + }; + +There is also the extensive splat (A.K.A. "megasplat"), which allows +extensive greedier matching, available using two asterisks. The additional +path is broken down and returned as an arrayref: + + get '/entry/*/tags/**' => sub { + my ( $entry_id, $tags ) = splat; + my @tags = @{$tags}; + }; + +The C<splat> keyword in the above example for the route F</entry/1/tags/one/two> +would set C<$entry_id> to C<1> and C<$tags> to C<['one', 'two']>. + +=head2 start + +Starts the application or the standalone server (depending on the deployment +choices). + +This keyword should be called at the very end of the script, once all routes +are defined. At this point, Dancer2 takes over. + +=head2 to_app + +Returns the PSGI coderef for the current (and only the current) application. + +You can call it as a method on the class or as a DSL: + + my $app = MyApp->to_app; + + # or + + my $app = to_app; + +There is a +L<Dancer Advent Calendar article|http://advent.perldancer.org/2014/9> covering +this keyword and its usage further. + +=head2 psgi_app + +Provides the same functionality as C<to_app> but uses the deprecated +Dispatcher engine. You should use C<to_app> instead. + +=head2 status + +Changes the status code provided by an action. By default, an action will +produce an C<HTTP 200 OK> status code, meaning everything is OK: + + get '/download/:file' => { + if (! -f route_parameters->get('file')) { + status 'not_found'; + return "File does not exist, unable to download"; + } + # serving the file... + }; + +In that example, Dancer will notice that the status has changed, and will +render the response accordingly. + +The C<status> keyword receives either a numeric status code or its name in +lower case, with underscores as a separator for blanks - see the list in +L<Dancer2::Core::HTTP/"HTTP CODES">. As an example, The above call translates +to setting the code to C<404>. + +=head2 template + +Returns the response of processing the given template with the given +parameters (and optional settings), wrapping it in the default or specified +layout too, if layouts are in use. + +An example of a route handler which returns the result of using template to +build a response with the current template engine: + + get '/' => sub { + ... + return template 'some_view', { token => 'value'}; + }; + +Note that C<template> simply returns the content, so when you use it in a +route handler, if execution of the route handler should stop at that point, +make sure you use C<return> to ensure your route handler returns the content. + +Since C<template> just returns the result of rendering the template, you can +also use it to perform other templating tasks, e.g. generating emails: + + post '/some/route' => sub { + if (...) { + email { + to => 'someone@example.com', + from => 'foo@example.com', + subject => 'Hello there', + msg => template('emails/foo', { name => body_parameters->get('name') }), + }; + + return template 'message_sent'; + } else { + return template 'error'; + } + }; + +Compatibility notice: C<template> was changed in version 1.3090 to +immediately interrupt execution of a route handler and return the content, +as it's typically used at the end of a route handler to return content. +However, this caused issues for some people who were using C<template> to +generate emails etc, rather than accessing the template engine directly, so +this change has been reverted in 1.3091. + +The first parameter should be a template available in the views directory, +the second one (optional) is a hashref of tokens to interpolate, and the +third (again optional) is a hashref of options. + +For example, to disable the layout for a specific request: + + get '/' => sub { + template 'index', {}, { layout => undef }; + }; + +Or to request a specific layout, of course: + + get '/user' => sub { + template 'user', {}, { layout => 'user' }; + }; + +Some tokens are automatically added to your template (C<perl_version>, +C<dancer_version>, C<settings>, C<request>, C<vars> and, if you +have sessions enabled, C<session>). Check L<Default Template +Variables|Dancer2::Manual/Default-Template-Variables> +for further details. + +=head2 to_dumper ($structure) + +Serializes a structure with Data::Dumper. + +Calling this function will B<not> trigger the serialization's hooks. + +=head2 to_json ($structure, \%options) + +Serializes a structure to JSON. You should probably use C<encode_json> instead +which handles encoding the result for you. + +=head2 to_yaml ($structure) + +Serializes a structure to YAML. + +Calling this function will B<not> trigger the serialization's hooks. + +=head2 true + +Constant that returns a true value (1). + +=head2 upload + +Provides access to file uploads. Any uploaded file is accessible as a +L<Dancer2::Core::Request::Upload> object. You can access all parsed uploads +via: + + post '/some/route' => sub { + my $file = upload('file_input_foo'); + # $file is a Dancer2::Core::Request::Upload object + }; + +If you named multiple inputs of type "file" with the same name, the C<upload> +keyword would return an Array of L<Dancer2::Core::Request::Upload> objects: + + post '/some/route' => sub { + my ($file1, $file2) = upload('files_input'); + # $file1 and $file2 are Dancer2::Core::Request::Upload objects + }; + +You can also access the raw hashref of parsed uploads via the current +C<request> object: + + post '/some/route' => sub { + my $all_uploads = request->uploads; + # $all_uploads->{'file_input_foo'} is a Dancer2::Core::Request::Upload object + # $all_uploads->{'files_input'} is an arrayref of Dancer2::Core::Request::Upload objects + }; + +Note that you can also access the filename of the upload received via the +C<body_parameters> keyword: + + post '/some/route' => sub { + # body_parameters->get('files_input') is the filename of the file uploaded + }; + +See L<Dancer2::Core::Request::Upload> for details about the interface provided. + +=head2 uri_for + +Returns a fully-qualified URI for the given path: + + get '/' => sub { + redirect uri_for('/path'); + # can be something like: http://localhost:5000/path + }; + +Query string parameters can be provided by passing a hashref as a second param: + + uri_for('/path', { foo => 'bar' }); + # would return e.g. http://localhost:5000/path?foo=bar + +By default, the parameters will be URL encoded: + + uri_for('/path', { foo => 'hope;faith' }); + # would return http://localhost:5000/path?foo=hope%3Bfaith + +If desired (for example, if you've already encoded your query +parameters and you want to prevent double encoding) you can disable +URL encoding via a third parameter: + + uri_for('/path', { foo => 'qux%3Dquo' }, 1); + # would return http://localhost:5000/path?foo=qux%3Dquo + +=head2 captures + +Returns a reference to a copy of C<%+>, if there are named captures in the +route's regular expression. + +Named captures are a feature of Perl 5.10, and are not supported in earlier +versions: + + get qr{ + / (?<object> user | ticket | comment ) + / (?<action> delete | find ) + / (?<id> \d+ ) + /?$ + }x + , sub { + my $value_for = captures; + "i don't want to $$value_for{action} the $$value_for{object} $$value_for{id} !" + }; + +=head2 var + +Provides an accessor for variables shared between hooks and route +handlers. Given a key/value pair, it sets a variable: + + hook before => sub { + var foo => 42; + }; + +Later, route handlers and other hooks will be able to read that variable: + + get '/path' => sub { + my $foo = var 'foo'; + ... + }; + +=head2 vars + +Returns the hashref of all shared variables set during the hook/route +chain with the C<var> keyword: + + get '/path' => sub { + if (vars->{foo} eq 42) { + ... + } + }; + +=head2 warning + +Logs a warning message through the current logger engine: + + warning "This is a warning"; + +See L<Dancer2::Core::Role::Logger> for details on how to configure where log +messages go. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Manual/Deployment.pod b/lib/Dancer2/Manual/Deployment.pod new file mode 100644 index 00000000..ee88388e --- /dev/null +++ b/lib/Dancer2/Manual/Deployment.pod @@ -0,0 +1,732 @@ +# PODNAME: Dancer2::Manual::Deployment +# ABSTRACT: common ways to put your Dancer app into use + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Manual::Deployment - common ways to put your Dancer app into use + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Dancer has been designed to be flexible, and this flexibility extends to your +choices when deploying your Dancer app. + +=head2 Running stand-alone + +To start your application, just run plackup: + + $ plackup bin/app.psgi + HTTP::Server::PSGI: Accepting connections at http://0:5000/ + +Point your browser at it, and away you go! + +This option can be useful for small personal web apps or internal apps, but if +you want to make your app available to the world, it probably won't suit you. + +=head3 Auto Reloading the Application + +While developing your application, it is often handy to have the server +automatically reload your application when changes are made. There are +two recommended ways of handling this with Dancer: using C< plackup -r > +and L<Plack::Loader::Shotgun>. Both have their advantages and disadvantages +(which will be explained below). + +Regardless of the method you use, it is B< not > recommended that you +automatically reload your applications in a production environment, for +reasons of performance, deployment best practices, etc. + +For Dancer 1 programmers that used the C< auto_reload > option, please use +one of these alternatives instead: + +=head4 Auto reloading with C< plackup -r > + +Plack's built-in reloader will reload your application anytime a file in +your application's directory (usually, F< /bin >) changes. You will likely +want to monitor your F< lib/ > directory too, using the C< -R > option: + + $ plackup -r -R lib bin/app.psgi + +There is a performance hit associated with this, as Plack will spin off +a separate process that monitors files in the application and other +specified directories. If the timestamp of any files in a watched +directory changes, the application is recompiled and reloaded. + +See the L<plackup> docs for more information on the C< -r > and C< -R > +options. + +=head4 Auto reloading with plackup and Shotgun + +There may be circumstances where Plack's built-in reloader won't work for +you, be it for the way it looks for changes, or because there are many +directories you need to monitor, or you want to reload the application any +time one of the modules in Perl's F< lib/ > path changes. +L<Plack::Loader::Shotgun> makes this easy by recompiling the application +on every request. + +To use Shotgun, specify it using the loader argument to C< plackup (-L) >: + + $ plackup -L Shotgun bin/app.psgi + +The Shotgun, while effective, can quickly cause you performance issues, even +during the development phase of your application. As the number of plugins +you use in your application grows, as the number of static resources (images, +etc.) grows, the more requests your server process needs to handle. Since +each request recompiles the application, even simple page refreshes can get +unbearably slow over time. Use with caution. + +You can bypass Shotgun's auto-reloading of specific modules with the +C< -M > switch: + + $ plackup -L Shotgun -M<MyApp::Foo> -M<MyApp::Bar> bin/app.psgi + +On Windows, Shotgun loader is known to cause huge memory leaks in a +fork-emulation layer. If you are aware of this and still want to run the +loader, please use the following command: + + > set PLACK_SHOTGUN_MEMORY_LEAK=1 && plackup -L Shotgun bin\app.psgi + HTTP::Server::PSGI: Accepting connections at http://0:5000/ + +B<Please note: > if you are using Dancer 2's asynchronous capabilities, using +Shotgun will kill Twiggy. If you need async processing, consider an +alternative to Shotgun. + +=head2 Running under Apache + +You can run your Dancer app from Apache using the following examples: + +=head3 As a CGI script + +In its simplest form, your Dancer app can be run as a simple CGI script +out-of-the-box. You will need to enable the Apache mod_cgi or mod_cgid modules +(C<a2enmod cgi> or C<a2enmod cgid> on Debian-based systems) and mod_rewrite +(C<a2enmod rewrite>). The Perl module L<Plack::Runner> is required. + +The following is an example apache configuration. Depending on your Apache +configuration layout, this should be placed in C<httpd.conf> or +C<sites-available/*site*>. The configuration options can also be placed in +C<.htaccess> files if you prefer. + + <VirtualHost *:80> + ServerName www.example.com + + # /srv/www.example.com is the root of your + # dancer application + DocumentRoot /srv/www.example.com/public + + ServerAdmin you@example.com + + <Directory "/srv/www.example.com/public"> + AllowOverride None + Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch + AddHandler cgi-script .cgi + # Apache 2.2 + Order allow,deny + Allow from all + # Apache 2.4 + Require all granted + </Directory> + + RewriteEngine On + RewriteCond %{REQUEST_FILENAME} !-f + RewriteRule ^(.*)$ /dispatch.cgi$1 [QSA,L] + + ErrorLog /var/log/apache2/www.example.com-error.log + CustomLog /var/log/apache2/www.example.com-access_log common + </VirtualHost> + +Now you can access your dancer application URLs as if you were using the +embedded web server. + + http://www.example.com/ + +This option is a no-brainer, easy to setup and low maintenance, but serves +requests slower than all other options, as each time a request is made to your +server, Apache will start your application. This might be suitable for a small, +occasionally-used sites, as the application is not using resources when it is +not being accessed. For anything more, you probably want to use FastCGI instead +(see next section). + +To list all currently loaded modules, type C<apachectl -M> +(C<apache2ctl -M> on Debian/Ubuntu). + +=head3 As a FastCGI script + +This has all the easy-to-setup and low-maintenance advantages of CGI, but is +much faster for each request, as it keeps a copy of the application running all +the time. + +You will still need to enable C<mod_rewrite>, but will need to use a FastCGI +module instead of a CGI module. There are 3 available: +L<mod_fcgid|http://httpd.apache.org/mod_fcgid/>, +L<mod_fastcgi|http://www.fastcgi.com/> and +L<mod_proxy_fcgi|https://httpd.apache.org/docs/trunk/mod/mod_proxy_fcgi.html>. +For this example, we will use mod_fastcgi (C<a2enmod fastcgi> in Debian). + +The CGI configuration above now changes as follows (differences highlighted +with XXX): + + <VirtualHost *:80> + ServerName www.example.com + + # /srv/www.example.com is the root of your + # dancer application + DocumentRoot /srv/www.example.com/public + + ServerAdmin you@example.com + + # XXX Start a FastCGI server to run in the background + FastCgiServer /srv/www.example.com/public/dispatch.fcgi + + <Directory "/srv/www.example.com/public"> + AllowOverride None + Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch + # XXX Use FastCGI handler instead of CGI + AddHandler fastcgi-script .fcgi + # Apache 2.2 + Order allow,deny + Allow from all + # Apache 2.4 + Require all granted + </Directory> + + RewriteEngine On + RewriteCond %{REQUEST_FILENAME} !-f + # Run FastCGI dispatcher instead of CGI dispatcher + RewriteRule ^(.*)$ /dispatch.fcgi$1 [QSA,L] + + ErrorLog /var/log/apache2/www.example.com-error.log + CustomLog /var/log/apache2/www.example.com-access_log common + </VirtualHost> + +This is the easiest way to get a production server up and running, as there is +no need to worry about daemonizing your application. Apache manages all that +for you. + +=head4 Reloading your application + +You can use C<apache2ctl restart> or C<apache2ctl graceful> to reload your +application. The latter will be more friendly to your users in a production +environment. If your application loads relatively quickly, then it should go +unnoticed. + +=head4 Configuration + +See L<http://www.fastcgi.com/mod_fastcgi/docs/mod_fastcgi.html> for FastCGI +configuration options. An example configuration: + + FastCgiServer /srv/www.example.com/public/dispatch.fcgi -processes 5 -initial-env DANCER_ENVIRONMENT="production" + +=head3 With Plack + +You can run your app from Apache using PSGI (Plack), with a config like the +following: + + <VirtualHost myapp.example.com> + ServerName www.myapp.example.com + ServerAlias myapp.example.com + DocumentRoot /websites/myapp.example.com + + <Directory /home/myapp/myapp> + AllowOverride None + Order allow,deny + Allow from all + </Directory> + + <Location /> + SetHandler perl-script + PerlResponseHandler Plack::Handler::Apache2 + PerlSetVar psgi_app /websites/myapp.example.com/app.psgi + </Location> + + ErrorLog /websites/myapp.example.com/logs/error_log + CustomLog /websites/myapp.example.com/logs/access_log common + </VirtualHost> + +To set the environment you want to use for your application (production or +development), you can set it this way: + + <VirtualHost> + ... + SetEnv DANCER_ENVIRONMENT "production" + ... + </VirtualHost> + +=head3 Running multiple applications under the same virtualhost + +If you want to deploy multiple applications under the same C<VirtualHost> +(using one application per directory, for example) you can use the following +example Apache configuration. + +This example uses the FastCGI dispatcher that comes with Dancer, but you should +be able to adapt this to use any other way of deployment described in this +guide. The only purpose of this example is to show how to deploy multiple +applications under the same base directory/virtualhost. + + <VirtualHost *:80> + ServerName localhost + DocumentRoot "/path/to/rootdir" + RewriteEngine On + RewriteCond %{REQUEST_FILENAME} !-f + + <Directory "/path/to/rootdir"> + AllowOverride None + Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch + Order allow,deny + Allow from all + AddHandler fastcgi-script .fcgi + </Directory> + + RewriteRule /App1(.*)$ /App1/public/dispatch.fcgi$1 [QSA,L] + RewriteRule /App2(.*)$ /App2/public/dispatch.fcgi$1 [QSA,L] + ... + RewriteRule /AppN(.*)$ /AppN/public/dispatch.fcgi$1 [QSA,L] + </VirtualHost> + +Of course, if your Apache configuration allows that, you can put the +RewriteRules in a .htaccess file directly within the application's directory, +which lets you add a new application without changing the Apache configuration. + +=head2 Running on PSGI-based Perl webservers + +A number of Perl web servers supporting PSGI are available on cpan: + +=over 4 + +=item L<Starman> + +C<Starman> is a high performance web server, with support for preforking, +signals, multiple interfaces, graceful restarts and dynamic worker pool +configuration. + +=item L<Twiggy> + +C<Twiggy> is an C<AnyEvent> web server, it's light and fast. + +=item L<Corona> + +C<Corona> is a C<Coro> based web server. + +=back + +Similar to running standalone, use plackup to start your application +(see L<Plack> and specific servers above for all available options): + + $ plackup bin/app.psgi + $ plackup -E deployment -s Starman --workers=10 -p 5001 -a bin/app.psgi + +As you can see, the scaffolded Perl script for your app can be used as a PSGI +startup file. + +=head3 Enabling content compression + +Content compression (gzip, deflate) can be easily enabled via a Plack +middleware (see L<Plack/Plack::Middleware>): L<Plack::Middleware::Deflater>. +It's a middleware to encode the response body in gzip or deflate, based on +the C<Accept-Encoding> HTTP request header. + +Enable it as you would enable any Plack middleware. First you need to +install L<Plack::Middleware::Deflater>, then in the handler (usually +F<app.psgi>) edit it to use L<Plack::Builder>, as described above: + + use Dancer2; + use MyWebApp; + use Plack::Builder; + + builder { + enable 'Deflater'; + dance; + }; + +To test if content compression works, trace the HTTP request and response +before and after enabling this middleware. Among other things, you should +notice that the response is gzip or deflate encoded, and contains a header +C<Content-Encoding> set to C<gzip> or C<deflate>. + +=head3 Creating a service + +You can turn your app into proper service running in background using one of +the following examples: + +=head4 Using Ubic + +L<Ubic> is an extensible perlish service manager. You can use it to start +and stop any services, automatically start them on reboots or daemon +failures, and implement custom status checks. + +A basic PSGI service description (usually in C</etc/ubic/service/application>): + + use parent qw(Ubic::Service::Plack); + + # if your application is not installed in @INC path: + sub start { + my $self = shift; + $ENV{PERL5LIB} = '/path/to/your/application/lib'; + $self->SUPER::start(@_); + } + + __PACKAGE__->new( + server => 'Starman', + app => '/path/to/your/application/app.psgi', + port => 5000, + user => 'www-data', + ); + +Run C<ubic start application> to start the service. + +=head4 Using daemontools + +daemontools is a collection of tools for managing UNIX services. You can use +it to easily start/restart/stop services. + +A basic script to start an application: (in C</service/application/run>) + + #!/bin/sh + + # if your application is not installed in @INC path: + export PERL5LIB='/path/to/your/application/lib' + + exec 2>&1 \ + /usr/local/bin/plackup -s Starman -a /path/to/your/application/app.psgi -p 5000 + +=head2 Running stand-alone behind a proxy / load balancer + +Another option would be to run your app stand-alone as described above, but then +use a proxy or load balancer to accept incoming requests (on the standard port +80, say) and feed them to your Dancer app. Also, in this case you might want +to look at the C<behind_proxy> configuration option, to make sure that all the +URLs are constructed properly. + + behind_proxy: 1 + +This setup can be achieved using various software; examples would include: + +=head3 Using Apache's mod_proxy + +You could set up a C<VirtualHost> for your web app, and proxy all requests through +to it: + + <VirtualHost mywebapp.example.com:80> + ProxyPass / http://localhost:3000/ + ProxyPassReverse / http://localhost:3000/ + </VirtualHost> + +Or, if you want your webapp to share an existing VirtualHost, you could have +it under a specified dir: + + ProxyPass /mywebapp/ http://localhost:3000/ + ProxyPassReverse /mywebapp/ http://localhost:3000/ + +It is important for you to note that the Apache2 modules C<mod_proxy> and +C<mod_proxy_http> must be enabled: + + $ a2enmod proxy + $ a2enmod proxy_http + +It is also important to set permissions for proxying for security purposes, +below is an example. + + <Proxy *> + Order allow,deny + Allow from all + </Proxy> + +=head3 Using perlbal + +C<Perlbal> is a single-threaded event-based server written in Perl supporting +HTTP load balancing, web serving, and a mix of the two, available from +L<http://www.danga.com/perlbal/> + +It processes hundreds of millions of requests a day just for LiveJournal, Vox +and TypePad and dozens of other "Web 2.0" applications. + +It can also provide a management interface to let you see various information on +requests handled etc. + +It could easily be used to handle requests for your Dancer apps, too. + +It can be easily installed from CPAN: + + perl -MCPAN -e 'install Perlbal' + +Once installed, you'll need to write a configuration file. See the examples +provided with perlbal, but you'll probably want something like: + + CREATE POOL my_dancers + POOL my_dancers ADD 10.0.0.10:3030 + POOL my_dancers ADD 10.0.0.11:3030 + POOL my_dancers ADD 10.0.0.12:3030 + POOL my_dancers ADD 10.0.0.13:3030 + + CREATE SERVICE my_webapp + SET listen = 0.0.0.0:80 + SET role = reverse_proxy + SET pool = my_dancers + SET persist_client = on + SET persist_backend = on + SET verify_backend = on + ENABLE my_webapp + +=head3 Using balance + +C<balance> is a simple load-balancer from Inlab Software, available from +L<http://www.inlab.de/balance.html>. + +It could be used simply to hand requests to a standalone Dancer app. You could +even run several instances of your Dancer app, on the same machine or on several +machines, and use a machine running C<balance> to distribute the requests between +them, for some serious heavy traffic handling! + +To listen on port 80, and send requests to a Dancer app on port 3000: + + balance http localhost:3000 + +To listen on a specified IP only on port 80, and distribute requests between +multiple Dancer apps on multiple other machines: + + balance -b 10.0.0.1 80 10.0.0.2:3000 10.0.0.3:3000 10.0.0.4:3000 + +=head3 Using Lighttpd + +You can use Lighttp's C<mod_proxy>: + + $HTTP["url"] =~ "/application" { + proxy.server = ( + "/" => ( + "application" => ( "host" => "127.0.0.1", "port" => 3000 ) + ) + ) + } + +This configuration will proxy all request to the B</application> path to the +path B</> on localhost:3000. + +=head3 Using Nginx + +with Nginx: + + upstream backendurl { + server unix:THE_PATH_OF_YOUR_PLACKUP_SOCKET_HERE.sock; + } + + server { + listen 80; + server_name YOUR_HOST_HERE; + + access_log /var/log/YOUR_ACCESS_LOG_HERE.log; + error_log /var/log/YOUR_ERROR_LOG_HERE.log info; + + root YOUR_ROOT_PROJECT/public; + location / { + try_files $uri @proxy; + access_log off; + expires max; + } + + location @proxy { + proxy_set_header Host $http_host; + proxy_set_header X-Forwarded-Host $host; + proxy_set_header X-Real-IP $remote_addr; + proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for; + proxy_pass http://backendurl; + } + + } + +You will need plackup to start a worker listening on a socket : + + cd YOUR_PROJECT_PATH + sudo -u www plackup -E production -s Starman --workers=2 -l THE_PATH_OF_YOUR_PLACKUP_SOCKET_HERE.sock -a bin/app.pl + +A good way to start this is to use C<daemontools> and place this line with +all environments variables in the "run" file. + +=head3 Using HAProxy + +C<HAProxy> is a reliable high-performance TCP/HTTP load balancer written in C available from +L<https://www.haproxy.org/>. + +Suppose we want to run an application at C<app.example.com:80> and would to use two +backends listen on hosts C<app-be1.example.com:3000> and C<app-be2.example.com:3000>. + +Here is HAProxy configuration file (haproxy.conf): + + global + nbproc 1 + maxconn 4096 + user nobody + group nobody + # haproxy logs will be collected by syslog + # syslog: unix socket path or tcp pair (ipaddress:port) + log /var/run/log local0 + daemon + # enable compression (haproxy v1.5-dev13 and above required) + tune.comp.maxlevel 5 + + defaults + log global + option httpclose + option httplog + option dontlognull + option forwardfor + option abortonclose + mode http + balance roundrobin + retries 3 + timeout connect 5s + timeout server 30s + timeout client 30s + timeout http-keep-alive 200m + # enable compression (haproxy v1.5-dev13 and above required) + compression algo gzip + compression type text/html application/javascript text/css application/x-javascript text/javascript + + # application frontend (available at http://app.example.com) + frontend app.example.com + bind :80 + # modify request headers + reqadd X-Forwarded-Proto:\ http + reqadd X-Forwarded-Port:\ 80 + # modify response headers + rspdel ^Server:.* + rspdel ^X-Powered-By:.* + rspadd Server:\ Dethklok\ (Unix/0.2.3) + rate-limit sessions 1024 + acl is-haproxy-stats path_beg /stats + # uncomment if you'd like to get haproxy usage statistics + # use_backend haproxy if is-haproxy-stats + default_backend dynamic + + # haproxy statistics (available at http://app.example.com/stats) + backend haproxy + stats uri /stats + stats refresh 180s + stats realm app.example.com\ haproxy\ statistics + # change credentials + stats auth admin1:password1 + stats auth admin2:password2 + stats hide-version + stats show-legends + + # application backends + backend dynamic + # change path_info to check and value of the Host header sent to application server + option httpchk HEAD / HTTP/1.1\r\nHost:\ app.example.com + server app1 app-be1.example.com:3000 check inter 30s + server app2 app-be2.example.com:3000 check inter 30s + +We will need to start the workers on each backend of our application. This can be done by starman utility: + + # on app-be1.example.com + $ starman --workers=2 --listen :3000 /path/to/app.pl + # on app-be2.example.com + $ starman --workers=2 --listen :3000 /path/to/app.pl + +Then start the haproxy itself: + + # check the configuration.. + $ sudo haproxy -c -f haproxy.conf + # now really start it.. + $ sudo haproxy -f haproxy.conf + +=head2 Running on lighttpd + +=head3 Running on lighttpd (CGI) + +To run as a CGI app on lighttpd, just create a soft link to the C<dispatch.cgi> +script (created when you run C<dancer -a MyApp>) inside your system's C<cgi-bin> +folder. Make sure C<mod_cgi> is enabled. + + ln -s /path/to/MyApp/public/dispatch.cgi /usr/lib/cgi-bin/mycoolapp.cgi + +=head3 Running on lighttpd (FastCGI) + +Make sure C<mod_fcgi> is enabled. You also must have L<FCGI> installed. + +This example configuration uses TCP/IP: + + $HTTP["url"] == "^/app" { + fastcgi.server += ( + "/app" => ( + "" => ( + "host" => "127.0.0.1", + "port" => "5000", + "check-local" => "disable", + ) + ) + ) + } + +Launch your application: + + plackup -s FCGI --port 5000 bin/app.psgi + +This example configuration uses a socket: + + $HTTP["url"] =~ "^/app" { + fastcgi.server += ( + "/app" => ( + "" => ( + "socket" => "/tmp/fcgi.sock", + "check-local" => "disable", + ) + ) + ) + } + +Launch your application: + + plackup -s FCGI --listen /tmp/fcgi.sock bin/app.psgi + +=head2 Performance Improvements + +The following modules can be used to speed up an app in Dancer2: + +=over 4 + +=item * L<URL::Encode::XS> + +=item * L<CGI::Deurl::XS> + +=item * L<HTTP::Parser::XS> + +=item * L<HTTP::XSCookies> + +=item * L<Scope::Upper> + +=item * L<Type::Tiny::XS> + +=back + +They would need to be installed separately. This is because L<Dancer2> does +not incorporate any C code, but it can get C-code compiled as a module. +Thus, these modules can be used for speed improvement provided: + +=over 4 + +=item * You have access to a C interpreter + +=item * You don't need to fatpack your application + +=back + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Manual/Migration.pod b/lib/Dancer2/Manual/Migration.pod new file mode 100644 index 00000000..dba84ddf --- /dev/null +++ b/lib/Dancer2/Manual/Migration.pod @@ -0,0 +1,606 @@ +package Dancer2::Manual::Migration; +# ABSTRACT: Migrating from Dancer to Dancer2 + +use strict; +use warnings; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Manual::Migration - Migrating from Dancer to Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 Migration from Dancer 1 to Dancer2 + +This document covers some changes that users will need to be aware of +while upgrading from L<Dancer> (version 1) to L<Dancer2>. + +=head2 Launcher script + +The default launcher script F<bin/app.pl> in L<Dancer> looked like this: + + #!/usr/bin/env perl + use Dancer; + use MyApp; + dance; + +In L<Dancer2> it is available as F<bin/app.psgi> and looks like this: + + #!/usr/bin/env perl + + use strict; + use warnings; + use FindBin; + use lib "$FindBin::Bin/../lib"; + + use MyApp; + MyApp->to_app; + +So you need to remove the C<use Dancer;> part, replace the C<dance;> command +by C<< MyApp->to_app; >> (where MyApp is the name of your application), and +add the following lines: + + use strict; + use warnings; + use FindBin; + use lib "$FindBin::Bin/../lib"; + +There is a L<Dancer Advent Calendar|http://advent.perldancer.org> article +L<< covering the C<to_app> keyword|http://advent.perldancer.org/2014/9 >> +and its usage. + +=head2 Configuration + +You specify a different location to the directory used for serving static (public) +content by setting the C<public_dir> option. In that case, you have to set +C<static_handler> option also. + +=head2 Apps + +1. In L<Dancer2>, each module is a B<separate application> with its own +namespace and variables. You can set the application name in each of your +L<Dancer2> application modules. Different modules can be tied into the same +app by setting the application name to the same value. + +For example, to set the appname directive explicitly: + +C<MyApp>: + + package MyApp; + use Dancer2; + use MyApp::Admin + + hook before => sub { + var db => 'Users'; + }; + + get '/' => sub {...}; + + 1; + +C<MyApp::Admin>: + + package MyApp::Admin; + use Dancer2 appname => 'MyApp'; + + # use a lexical prefix so we don't override it globally + prefix '/admin' => sub { + get '/' => sub {...}; + }; + + 1; + +Without the appname directive, C<MyApp::Admin> would not have access +to variable C<db>. In fact, when accessing C</admin>, the before hook would +not be executed. + +See L<Dancer2::Cookbook|https://metacpan.org/pod/Dancer2::Cookbook#Using-the-prefix-feature-to-split-your-application> +for details. + +2. To speed up an app in Dancer2, install the recommended modules listed in the +L<Dancer2::Manual::Deployment/"Performance Improvements"> section. + +=head2 Request + +The request object (L<Dancer2::Core::Request>) is now deferring much of +its code to L<Plack::Request> to be consistent with the known interface +to L<PSGI> requests. + +Currently the following attributes pass directly to L<Plack::Request>: + +C<address>, C<remote_host>, C<protocol>, C<port>, C<method>, C<user>, +C<request_uri>, C<script_name>, C<content_length>, C<content_type>, +C<content_encoding>, C<referer>, and C<user_agent>. + +If previous attributes returned I<undef> for no value beforehand, they +will return whatever L<Plack::Request> defines now, which just might be +an empty list. + +For example: + + my %data = ( + referer => request->referer, + user_agent => request->user_agent, + ); + +should be replaced by: + + my %data = ( + referer => request->referer || '', + user_agent => request->user_agent || '', + ); + +=head2 Plugins: plugin_setting + +C<plugin_setting> returns the configuration of the plugin. It can only be +called in C<register> or C<on_plugin_import>. + +=head2 Routes + +L<Dancer2> requires all routes defined via a string to begin with a leading +slash C</>. + +For example: + + get '0' => sub { + return "not gonna fly"; + }; + +would return an error. The correct way to write this would be to use +C<get '/0'> + +=head2 Route parameters + +The C<params> keyword which provides merged parameters used to allow body +parameters to override route parameters. Now route parameters take +precedence over query parameters and body parameters. + +We have introduced C<route_parameters> to retrieve parameter values from +the route matching. Please refer to L<Dancer2::Manual> for more +information. + +=head2 Tests + +Dancer2 recommends the use of L<Plack::Test>. + +For example: + + use strict; + use warnings; + use Test::More tests => 2; + use Plack::Test; + use HTTP::Request::Common; + + { + package App::Test; # or whatever you want to call it + get '/' => sub { template 'index' }; + } + + my $test = Plack::Test->create( App::Test->to_app ); + my $res = $test->request( GET '/' ); + + ok( $res->is_success, '[GET /] Successful' ); + like( $res->content, qr{<title>Test2</title>}, 'Correct title' ); + +Other modules that could be used for testing are: + +=over 4 + +=item * L<Test::TCP> + +=item * L<Test::WWW::Mechanize::PSGI> + +=back + +=head3 Logs + +The C<logger_format> in the Logger role (L<Dancer2::Core::Role::Logger>) +is now C<log_format>. + +C<read_logs> can no longer be used, as with L<Dancer2::Test>. Instead, +L<Dancer2::Logger::Capture> could be used for testing, to capture all +logs to an object. + +For example: + + use strict; + use warnings; + use Test::More import => ['!pass']; + use Plack::Test; + use HTTP::Request::Common; + use Ref::Util qw<is_coderef>; + + { + package App; + use Dancer2; + + set log => 'debug'; + set logger => 'capture'; + + get '/' => sub { + debug 'this is my debug message'; + return 1; + }; + } + + my $app = Dancer2->psgi_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + my $res = $cb->( GET '/' ); + is $res->code, 200; + + my $trap = App->dancer_app->logger_engine->trapper; + + is_deeply $trap->read, [ + { level => 'debug', message => 'this is my debug message' } + ]; + }; + +=head2 Exports: Tags + +The following tags are not needed in L<Dancer2>: + + use Dancer2 qw(:syntax); + use Dancer2 qw(:tests); + use Dancer2 qw(:script); + +The C<plackup> command should be used instead. It provides a development +server and reads the configuration options in your command line utilities. + +=head2 Engines + +=over 4 + +=item * Engines receive a logging callback + +Engines now receive a logging callback named C<log_cb>. Engines can use it +to log anything in run-time, without having to worry about what logging +engine is used. + +This is provided as a callback because the logger might be changed in +run-time and we want engines to be able to always reach the current one +without having a reference back to the core application object. + +The logger engine doesn't have the attribute since it is the logger itself. + +=item * Engines handle encoding consistently + +All engines are now expected to handle encoding on their own. User code +is expected to be in internal Perl representation. + +Therefore, all serializers, for example, should deserialize to the Perl +representation. Templates, in turn, encode to UTF-8 if requested by the +user, or by default. + +One side-effect of this is that C<from_yaml> will call L<YAML>'s C<Load> +function with decoded input. + +=back + +=head3 Templating engine changes + +Whereas in Dancer1, the following were equivalent for Template::Toolkit: + + template 'foo/bar' + template '/foo/bar' + +In Dancer2, when using L<Dancer2::Template::TemplateToolkit>, the version with +the leading slash will try to locate C</foo/bar> relative to your filesystem +root, not relative to your Dancer application directory. + +The L<Dancer2::Template::Simple> engine is unchanged in this respect. + +Whereas in Dancer1, template engines have the methods: + + $template_engine->view('foo.tt') + $template_engine->view_exists('foo.tt') + +In Dancer2, you should instead write: + + $template_engine->view_pathname('foo.tt') + $template_engine->pathname_exists($full_path) + +You may not need these unless you are writing a templating engine. + +=head3 Serializers + +You no longer need to implement the C<loaded> method. It is simply +unnecessary. + +=head3 Sessions + +Now the L<Simple|Dancer2::Session::Simple> session engine is turned on +by default, unless you specify a different one. + +=head2 Configuration + +=head3 C<public_dir> + +You cannot set the public directory with C<setting> now. Instead you +will need to call C<config>: + + # before + setting( 'public_dir', 'new_path/' ); + + # after + config->{'public_dir'} = 'new_path'; + +=head3 warnings + +The C<warnings> configuration option, along with the environment variable +C<DANCER_WARNINGS>, have been removed and have no effect whatsoever. + +They were added when someone requested to be able to load Dancer without +the L<warnings> pragma, which it adds, just like L<Moose>, L<Moo>, and +other modules provide. + +If you want this to happen now (which you probably shouldn't be doing), +you can always control it lexically: + + use Dancer2; + no warnings; + +You can also use Dancer2 within a narrower scope: + + { use Dancer2 } + use strict; + # warnings are not turned on + +However, having L<warnings> turned it is very recommended. + +=head3 server_tokens + +The configuration C<server_tokens> has been introduced in the reverse (but +more sensible, and Plack-compatible) form as C<no_server_tokens>. + +C<DANCER_SERVER_TOKENS> changed to C<DANCER_NO_SERVER_TOKENS>. + +=head3 engines + +If you want to use Template::Toolkit instead of the built-in simple templating +engine you used to enable the following line in the config.yml file. + + template: "template_toolkit" + +That was enough to get started. The start_tag and end_tag it used were the same as in +the simple template <% and %> respectively. + +If you wanted to further customize the Template::Toolkit you could also enable or add +the following: + + engines: + template_toolkit: + encoding: 'utf8' + start_tag: '[%' + end_tag: '%]' + +In Dancer 2 you can also enable Template::Toolkit with the same configuration option: + + template: "template_toolkit" + +But the default start_tag and end_tag are now [% and %], so if you used the default in Dancer 1 +now you will have to explicitly change the start_tag and end_tag values. +The configuration also got an extral level of depth. Under the C<engine> key there is a C<template> +key and the C<template_toolkit> key comes below that. As in this example: + + engines: + template: + template_toolkit: + start_tag: '<%' + end_tag: '%>' + +In a nutshell, if you used to have + + template: "template_toolkit" + +You need to replace it with + + template: "template_toolkit" + engines: + template: + template_toolkit: + start_tag: '<%' + end_tag: '%>' + +=head4 Session engine + +The session engine is configured in the C<engine> section. + +=over 4 + +=item * C<session_name> changed to C<cookie_name>. + +=item * C<session_domain> changed to C<cookie_domain>. + +=item * C<session_expires> changed to C<cookie_duration>. + +=item * C<session_secure> changed to C<is_secure>. + +=item * C<session_is_http_only> changed to C<is_http_only>. + +=back + +L<Dancer2> also adds two attributes for session: + +=over 4 + +=item * C<cookie_path> +The path of the cookie to create for storing the session key. Defaults to "/". + +=item * C<session_duration> +Duration in seconds before sessions should expire, regardless of cookie +expiration. If set, then SessionFactories should use this to enforce a limit on +session validity. + +=back + +See L<Dancer2::Core::Role::SessionFactory> for more detailed documentation +for these options, or the particular session engine for other supported options. + + session: Simple + + engines: + session: + Simple: + cookie_name: dance.set + cookie_duration: '24 hours' + is_secure: 1 + is_http_only: 1 + +=head3 Plack Middleware + +In Dancer1 you could set up Plack Middleware using a C<plack_middlewares> key +in your C<config.yml> file. Under Dancer2 you will instead need to invoke +middleware using L<Plack::Builder>, as demonstrated in +L<Dancer2::Manual::Deployment>. + +=head2 Keywords + +=head3 Calling Keywords Explicitly + +In Dancer1, keywords could be imported individually into a package: + + package MyApp; + use Dancer qw< get post params session >; + + get '/foo' { ... }; + +Any keywords you did't export could be called explicitly: + + package MyApp; + use Dancer qw< get post params session >; + use List::Util qw< any >; + + Dancer::any sub { ... }; + +Dancer2's DSL is implemented differently. Keywords only exist in the namespace +of the package which C<use>s Dancer2, i.e. there is no C<Dancer2::any>, only +e.g. C<MyApp::any>. + +If you only want individual keywords, you can write a shim as follows: + + package MyApp::DSL; + use Dancer2 appname => 'MyApp'; + + use Exporter qw< import >; + + our @EXPORT = qw< get post ... > + +Then in other packages: + + package MyApp; + + use MyApp::DSL qw< get post >; + + MyApp::DSL::any sub { ... }; + +=head3 appdir + +This keyword does not exist in Dancer2. However, the same information can be +found in C<< config->{'appdir'} >>. + +=head3 load + +This keyword is no longer required. Dancer2 loads the environment +automatically and will not reload any other environment when called with +L<load>. (It's a good thing.) + +=head3 param_array + +This keyword doesn't exist in Dancer2. + +=head3 session + +In L<Dancer> a session was created and a cookie was sent just by rendering a page +using the C<template> function. In L<Dancer2> one needs to actually set a value in +a session object using the C<session> function in order to create the session +and send the cookie. + +The session keyword has multiple states: + +=over 4 + +=item * No arguments + +Without any arguments, the session keyword returns a L<Dancer2::Core::Session> +object, which has methods for L<read|Dancer2::Core::Session/read>, +L<write|Dancer2::Core::Session/write>, and L<delete|Dancer2::Core::Session/delete>. + + my $session = session; + $session->read($key); + $session->write( $key => $value ); + $session->delete($key); + +=item * Single argument (key) + +If a single argument is provided, it is treated as the key, and it will retrieve +the value for it. + + my $value = session $key; + +=item * Two arguments (key, value) + +If two arguments are provided, they are treated as a key and a value, in which +case the session will assign the value to the key. + + session $key => $value; + +=item * Two arguments (key, undef) + +If two arguments are provided, but the second is B<undef>, the key will be +deleted from the session. + + session $key => undef; + +=back + +In Dancer 1 it wasn't possible to delete a key, but in Dancer2 we can finally +delete: + + # these two are equivalent + session $key => undef; + + my $session = session; + $session->delete($key); + +You can retrieve the whole session hash with the C<data> method: + + $session->data; + +To destroy a session, instead of writing: + + session->destroy + +In Dancer2, we write: + + app->destroy_session if app->has_session + +If you make changes to the session in an C<after> hook, your changes will +not be written to storage, because writing sessions to storage also takes +place in an (earlier) C<after> hook. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Manual/Testing.pod b/lib/Dancer2/Manual/Testing.pod new file mode 100644 index 00000000..87d66aff --- /dev/null +++ b/lib/Dancer2/Manual/Testing.pod @@ -0,0 +1,144 @@ +package Dancer2::Manual::Testing; +# ABSTRACT: Writing tests for Dancer2 + +use strict; +use warnings; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Manual::Testing - Writing tests for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 Basic application testing + +Since L<Dancer2> produces PSGI applications, you can easily write tests using +L<Plack::Test> and provide your Dancer application as the app for testing. + +A basic test (which we also scaffold with L<dancer2>) looks like this: + + use strict; + use warnings; + + use Test::More tests => 4; + use Plack::Test; + use HTTP::Request::Common; + + use_ok('MyApp'); + + # create an application + my $app = MyApp->to_app; + isa_ok( $app, 'CODE' ); + + # create a testing object + my $test = Plack::Test->create($app); + + # now you can call requests on it and get responses + # requests are of HTTP::Request + # responses are of HTTP::Response + + # "GET" from HTTP::Request::Common creates an HTTP::Request object + my $response = $test->request( GET '/' ); + + # same as: + # my $response = $test->request( HTTP::Request->new( GET => '/' ) ); + + ok( $response->is_success, 'Successful request' ); + is( $response->content, 'OK', 'Correct response content' ); + +Read the documentation for L<HTTP::Request> and L<HTTP::Request::Common> to +see the different options for sending parameters. + +=head1 Cookies + +If you don't want to use an entire user agent for this test, you can use +L<HTTP::Cookies> to store cookies and then retrieve them: + + use strict; + use warnings; + + use Test::More tests => 3; + use Plack::Test; + use HTTP::Request::Common; + use HTTP::Cookies; + + use_ok('MyApp'); + + my $url = 'http://localhost'; + my $jar = HTTP::Cookies->new(); + my $test = Plack::Test->create( MyApp->to_app ); + + subtest 'Create session' => sub { + my $res = $test->request( GET "$url/login" ); + ok( $res->is_success, 'Successful login' ); + + # extract cookies from the response and store in the jar + $jar->extract_cookies($res); + }; + + subtest 'Check session' => sub { + my $req = GET "$url/logout"; + + # add cookies to the request + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok( $res->is_success, 'Successful logout' ); + like( + $res->content, + 'Successfully logged out', + 'Got correct log out content', + ); + }; + +Please note that the request URL must include scheme and host for the call +to L<HTTP::Cookies/add_cookie_header> to work. + +=head1 Plugins + +In order to test plugins, you can create an application on the spot, as +part of the test script code, and use the plugin there. + + use strict; + use warnings; + + use Test::More tests => 2; + use Plack::Test; + use HTTP::Request::Common; + + { + package MyTestApp; + use Dancer2; + use Dancer2::Plugin::MyPlugin; + + get '/' => sub { my_keyword }; + } + + my $test = Plack::Test->create( MyTestApp->to_app ); + my $res = $test->request( GET '/' ); + + ok( $res->is_success, 'Successful request' ); + is( $res->content, 'MyPlugin-MyKeyword', 'Correct content' ); + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Plugin.pm b/lib/Dancer2/Plugin.pm new file mode 100644 index 00000000..24f245fb --- /dev/null +++ b/lib/Dancer2/Plugin.pm @@ -0,0 +1,1107 @@ +package Dancer2::Plugin; +# ABSTRACT: base class for Dancer2 plugins +$Dancer2::Plugin::VERSION = '0.300000'; +use strict; +use warnings; + +use Moo; +use Carp; +use List::Util qw/ reduce /; +use Module::Runtime 'require_module'; +use Attribute::Handlers; +use Scalar::Util; +use Ref::Util qw<is_arrayref is_coderef>; + +our $CUR_PLUGIN; + +extends 'Exporter::Tiny'; + +with 'Dancer2::Core::Role::Hookable'; + +has app => ( + is => 'ro', + weak_ref => 1, + required => 1, +); + +has config => ( + is => 'ro', + lazy => 1, + default => sub { + my $self = shift; + my $config = $self->app->config; + my $package = ref $self; # TODO + $package =~ s/Dancer2::Plugin:://; + $config->{plugins}{$package} || {}; + }, +); + +my $_keywords = {}; +sub keywords { $_keywords } + +my $REF_ADDR_REGEX = qr{ + [A-Za-z0-9\:\_]+ + =HASH + \( + ([0-9a-fx]+) + \) +}x; +my %instances; + +# backwards compatibility +our $_keywords_by_plugin = {}; + +has '+hooks' => ( + default => sub { + my $plugin = shift; + my $name = 'plugin.' . lc ref $plugin; + $name =~ s/Dancer2::Plugin:://i; + $name =~ s/::/_/g; + + +{ + map { join( '.', $name, $_ ) => [] } + @{ $plugin->ClassHooks } + }; + }, +); + +sub add_hooks { + my $class = shift; + push @{ $class->ClassHooks }, @_; +} + +sub execute_plugin_hook { + my ( $self, $name, @args ) = @_; + my $plugin_class = ref $self; + + $self->isa('Dancer2::Plugin') + or croak "Cannot call plugin hook ($name) from outside plugin"; + $plugin_class =~ s/^Dancer2::Plugin:://; # short names + + my $full_name = 'plugin.' . lc($plugin_class) . ".$name"; + $full_name =~ s/::/_/g; + + $self->app->execute_hook( $full_name, @args ); +} + +sub find_plugin { + my ( $self, $name ) = @_; + return $self->app->find_plugin($name); +} + +# both functions are there for D2::Core::Role::Hookable +# back-compatibility. Aren't used +sub supported_hooks { [] } +sub hook_aliases { $_[0]->{'hook_aliases'} ||= {} } + +### has() STUFF ######################################## + +# our wrapping around Moo::has, done to be able to intercept +# both 'from_config' and 'plugin_keyword' +sub _p2_has { + my $class = shift; + $class->_p2_has_from_config( $class->_p2_has_keyword( @_ ) ); +}; + +sub _p2_has_from_config { + my( $class, $name, %args ) = @_; + + my $config_name = delete $args{'from_config'} + or return ( $name, %args ); + + $args{lazy} = 1; + + if ( is_coderef($config_name) ) { + $args{default} ||= $config_name; + $config_name = 1; + } + + $config_name = $name if $config_name eq '1'; + my $orig_default = $args{default} || sub{}; + $args{default} = sub { + my $plugin = shift; + my $value = reduce { eval { $a->{$b} } } $plugin->config, split /\./, $config_name; + return defined $value ? $value: $orig_default->($plugin); + }; + + return $name => %args; +} + +sub _p2_has_keyword { + my( $class, $name, %args ) = @_; + + if( my $keyword = delete $args{plugin_keyword} ) { + + $keyword = $name if $keyword eq '1'; + + $class->keywords->{$_} = sub { (shift)->$name(@_) } + for ref $keyword ? @$keyword : $keyword; + } + + return $name => %args; +} + +### ATTRIBUTE HANDLER STUFF ######################################## + +# :PluginKeyword shenanigans + +sub PluginKeyword :ATTR(CODE,BEGIN) { + my( $class, $sym_ref, $code, undef, $args ) = @_; + + # importing at BEGIN stage doesn't work with 5.10 :-( + return unless ref $sym_ref; + + my $func_name = *{$sym_ref}{NAME}; + + $args = join '', @$args if is_arrayref($args); + + for my $name ( split ' ', $args || $func_name ) { + $class->keywords->{$name} = $code; + } + +} + +## EXPORT STUFF ############################################################## + +# this @EXPORT will only be taken +# into account when we do a 'use Dancer2::Plugin' +# I.e., it'll only do its magic for the +# plugins themselves, not when they are +# called +our @EXPORT = qw/ :plugin /; + +# compatibility - it will be removed soon! +my $no_dsl = {}; +my $exported_app = {}; +sub _exporter_expand_tag { + my( $class, $name, $args, $global ) = @_; + + my $caller = $global->{into}; + + $name eq 'no_dsl' and $no_dsl->{$caller} = 1; + # no_dsl check here is for compatibility only + # it will be removed soon! + return _exporter_plugin($caller) + if $name eq 'plugin' or $name eq 'no_dsl'; + + return _exporter_app($class,$caller,$global) + if $name eq 'app' and $caller->can('app') and !$no_dsl->{$class}; + + return; + +} + +# plugin has been called within a D2 app. Modify +# the app and export keywords +sub _exporter_app { + my( $class, $caller, $global ) = @_; + + $exported_app->{$caller} = 1; + + # The check for ->dsl->app is to handle plugins as well. + # Otherwise you can only import from a plugin to an app, + # but with this, you can import to anything + # that has a DSL with an app, which translates to "also plugins" + my $app = eval("${caller}::app()") || eval { $caller->dsl->app } ## no critic qw(BuiltinFunctions::ProhibitStringyEval) + or return; ## no critic + + return unless $app->can('with_plugin'); + + my $plugin = $app->with_plugin( '+' . $class ); + $global->{'plugin'} = $plugin; + + return unless $class->can('keywords'); + + # Add our hooks to the app, so they're recognized + # this is for compatibility so you can call execute_hook() + # without the fully qualified plugin name. + # The reason we need to do this here instead of when adding a + # hook is because we need to register in the app, and only now it + # exists. + # This adds a caveat that two plugins cannot register + # the same hook name, but that will be deprecated anyway. + {; + foreach my $hook ( @{ $plugin->ClassHooks } ) { + my $full_name = 'plugin.' . lc($class) . ".$hook"; + $full_name =~ s/Dancer2::Plugin:://i; + $full_name =~ s/::/_/g; + + # this adds it to the plugin + $plugin->hook_aliases->{$hook} = $full_name; + + # this adds it to the app + $plugin->app->hook_aliases->{$hook} = $full_name; + + # copy the hooks from the plugin to the app + # this is in case they were created at import time + # rather than after + @{ $plugin->app->hooks }{ keys %{ $plugin->hooks } } = + values %{ $plugin->hooks }; + } + } + + { + # get the reference + my ($plugin_addr) = "$plugin" =~ $REF_ADDR_REGEX; + + $instances{$plugin_addr}{'config'} = sub { $plugin->config }; + $instances{$plugin_addr}{'app'} = $plugin->app; + + Scalar::Util::weaken( $instances{$plugin_addr}{'app'} ); + + ## no critic + no strict 'refs'; + + # we used a forward declaration + # so the compiled form "plugin_setting;" can be overridden + # with this implementation, + # which works on runtime ("plugin_setting()") + # we can't use can() here because the forward declaration will + # create a CODE stub + no warnings 'redefine'; + *{"${class}::plugin_setting"} = sub { + my ($plugin_addr) = "$CUR_PLUGIN" =~ $REF_ADDR_REGEX; + + $plugin_addr + or Carp::croak('Can\'t find originating plugin'); + + # we need to do this because plugins might call "set" + # in order to change plugin configuration but it doesn't + # change the plugin object, it changes the app object + # so we merge them. + my $name = ref $CUR_PLUGIN; + $name =~ s/^Dancer2::Plugin:://g; + + my $plugin_inst = $instances{$plugin_addr}; + my $plugin_config = $plugin_inst->{'config'}->(); + my $app_plugin_config = $plugin_inst->{'app'}->config->{'plugins'}{$name}; + + return { %{ $plugin_config || {} }, %{ $app_plugin_config || {} } }; + }; + + # FIXME: + # why doesn't this work? it's like it's already defined somewhere + # but i'm not sure where. seems like AUTOLOAD runs it. + #$class->can('execute_hook') or + *{"${class}::execute_hook"} = sub { + # this can also be called by App.pm itself + # if the plugin is a + # "candidate" for a hook + # See: App.pm "execute_hook" method, "around" modifier + if ( $_[0]->isa('Dancer2::Plugin') ) { + # this means it's probably our hook, we need to verify it + my ( $plugin_self, $hook_name, @args ) = @_; + + my $plugin_class = lc $class; + $plugin_class =~ s/^dancer2::plugin:://; + $plugin_class =~ s{::}{_}g; + + # you're either calling it with the full qualifier or not + # if not, use the execute_plugin_hook instead + if ( $plugin->hooks->{"plugin.$plugin_class.$hook_name"} ) { + Carp::carp("Please use fully qualified hook name or " + . "the method execute_plugin_hook"); + $hook_name = "plugin.$plugin_class.$hook_name"; + } + + $hook_name =~ /^plugin\.$plugin_class/ + or Carp::croak('Unknown plugin called through other plugin'); + + # now we can't really use the app to execute it because + # the "around" modifier is the one calling us to begin + # with, so we need to call it directly ourselves + # this is okay because the modifier is there only to + # call candidates, like us (this is in fact how and + # why we were called) + $_->( $plugin_self, @args ) + for @{ $plugin->hooks->{$hook_name} }; + + return; + } + + return $plugin->app->execute_hook(@_); + }; + } + + local $CUR_PLUGIN = $plugin; + $_->($plugin) for @{ $plugin->_DANCER2_IMPORT_TIME_SUBS() }; + + map { [ $_ => {plugin => $plugin} ] } keys %{ $plugin->keywords }; +} + +# turns the caller namespace into +# a D2P2 class, with exported keywords +sub _exporter_plugin { + my $caller = shift; + require_module('Dancer2::Core::DSL'); + my $keywords_list = join ' ', keys %{ Dancer2::Core::DSL->dsl_keywords }; + + eval <<"END"; ## no critic + { + package $caller; + use Moo; + use Carp (); + use Attribute::Handlers; + + extends 'Dancer2::Plugin'; + + our \@EXPORT = ( ':app' ); + + around has => sub { + my( \$orig, \$name, \%args ) = \@_; + + if (ref \$name eq 'ARRAY' + && exists \$args{'plugin_keyword'} + && ref \$args{'plugin_keyword'} eq 'ARRAY') { + + Carp::croak('Setting "plugin_keyword" to an array is disallowed' + . ' when defining multiple attributes simultaneously'); + } + + \$orig->( ${caller}->_p2_has( \$_, \%args) ) + for ref \$name ? @\$name : \$name; + }; + + sub PluginKeyword :ATTR(CODE,BEGIN) { + goto &Dancer2::Plugin::PluginKeyword; + } + + sub execute_plugin_hook { + goto &Dancer2::Plugin::execute_plugin_hook; + } + + my \$_keywords = {}; + sub keywords { \$_keywords } + + my \$_ClassHooks = []; + sub ClassHooks { \$_ClassHooks } + + # this is important as it'll do the keywords mapping between the + # plugin and the app + sub register_plugin { Dancer2::Plugin::register_plugin(\@_) } + + sub register { + my ( \$keyword, \$sub ) = \@_; + \$_keywords->{\$keyword} = \$sub; + + \$keyword =~ /^[a-zA-Z_]+[a-zA-Z0-9_]*\$/ + or Carp::croak( + "You can't use '\$keyword', it is an invalid name" + . " (it should match ^[a-zA-Z_]+[a-zA-Z0-9_]*\\\$ )"); + + + grep +( \$keyword eq \$_ ), qw<$keywords_list> + and Carp::croak("You can't use '\$keyword', this is a reserved keyword"); + + \$Dancer2::Plugin::_keywords_by_plugin->{\$keyword} + and Carp::croak("You can't use \$keyword, " + . "this is a keyword reserved by " + . \$Dancer2::Plugin::_keywords_by_plugin->{\$keyword}); + + \$Dancer2::Plugin::_keywords_by_plugin->{\$keyword} = "$caller"; + + # Exporter::Tiny doesn't seem to generate the subs + # in the caller properly, so we have to do it manually + { + no strict 'refs'; + *{"${caller}::\$keyword"} = \$sub; + } + } + + my \@_DANCER2_IMPORT_TIME_SUBS; + sub _DANCER2_IMPORT_TIME_SUBS {\\\@_DANCER2_IMPORT_TIME_SUBS} + sub on_plugin_import (&) { + push \@_DANCER2_IMPORT_TIME_SUBS, \$_[0]; + } + + sub register_hook { goto &plugin_hooks } + + sub plugin_setting {}; + + sub plugin_args { + Carp::carp "Plugin DSL method 'plugin_args' is deprecated. " + . "Use '\\\@_' instead'.\n"; + + \@_; + } + } +END + + $no_dsl->{$caller} or eval <<"END"; ## no critic + { + package $caller; + + # FIXME: AUTOLOAD might pick up on this + sub dancer_app { + Carp::carp "Plugin DSL method 'dancer_app' is deprecated. " + . "Use '\\\$self->app' instead'.\n"; + + \$_[0]->app; + } + + # FIXME: AUTOLOAD might pick up on this + sub request { + Carp::carp "Plugin DSL method 'request' is deprecated. " + . "Use '\\\$self->app->request' instead'.\n"; + + \$_[0]->app->request; + } + + # FIXME: AUTOLOAD might pick up on this + sub var { + Carp::carp "Plugin DSL method 'var' is deprecated. " + . "Use '\\\$self->app->request->var' instead'.\n"; + + shift->app->request->var(\@_); + } + + # FIXME: AUTOLOAD might pick up on this + sub hook { + Carp::carp "Plugin DSL method 'hook' is deprecated. " + . "Use '\\\$self->app->add_hook' instead'.\n"; + + shift->app->add_hook( + Dancer2::Core::Hook->new( name => shift, code => shift ) ); + } + + } +END + + die $@ if $@; + + my $app_dsl_cb = _find_consumer(); + + if ( $app_dsl_cb ) { + my $dsl = $app_dsl_cb->(); + + { + ## no critic qw(TestingAndDebugging::ProhibitNoWarnings) + no strict 'refs'; + no warnings 'redefine'; + *{"${caller}::dsl"} = sub {$dsl}; + } + } + + return map { [ $_ => { class => $caller } ] } + qw/ plugin_keywords plugin_hooks /; +} + +sub _find_consumer { + my $class; + + ## no critic qw(ControlStructures::ProhibitCStyleForLoops) + for ( my $i = 1; my $caller = caller($i); $i++ ) { + $class = $caller->can('dsl') + and last; + } + + # If you use a Dancer2 plugin outside a Dancer App, this fails. + # It also breaks a bunch of the tests. -- SX + #$class + # or croak('Could not find Dancer2 app'); + + return $class; +}; + +# This has to be called for now at the end of every plugin package, in order to +# map the keywords of the associated app to the plugin, so that these keywords +# can be called from within the plugin code. This function is deprecated, as +# it's tied to the old plugin system. It's kept here for backcompat reason, but +# should go away with the old plugin system. +sub register_plugin { + + my $plugin_module = caller(1); + + # if you ask yourself why we do the injection in the plugin + # module namespace every time the plugin is used, and not only + # once, it's because it can be used by different app that could + # have a different DSL with a different list of keywords. + + my $_DANCER2_IMPORT_TIME_SUBS = $plugin_module->_DANCER2_IMPORT_TIME_SUBS; + unshift(@$_DANCER2_IMPORT_TIME_SUBS, sub { + my $app_dsl_cb = _find_consumer(); + + # Here we want to verify that "register_plugin" compat keyword + # was in fact only called from an app. + $app_dsl_cb + or Carp::croak( + 'I could not find a Dancer App for this plugin'); + + my $dsl = $app_dsl_cb->(); + + foreach my $keyword ( keys %{ $dsl->dsl_keywords} ) { + # if not yet defined, inject the keyword in the plugin + # namespace, but make sure the code will always get the + # coderef from the right associated app, because one plugin + # can be used by multiple apps. Note that we remove the + # first parameter (plugin instance) from what we pass to + # the keyword implementation of the App + no strict 'refs'; + $plugin_module->can($keyword) + or *{"${plugin_module}::$keyword"} = sub { + my $coderef = shift()->app->name->can($keyword); + $coderef->(@_); + }; + } + }); +} + +sub _exporter_expand_sub { + my( $plugin, $name, $args, $global ) = @_; + my $class = $args->{class}; + + return _exported_plugin_keywords($plugin,$class) + if $name eq 'plugin_keywords'; + + return _exported_plugin_hooks($class) + if $name eq 'plugin_hooks'; + + $exported_app->{ $global->{'into'} } + or Carp::croak('Specific subroutines cannot be exported from plugin'); + + # otherwise, we're exporting a keyword + + my $p = $args->{plugin}; + my $sub = $p->keywords->{$name}; + return $name => sub(@) { + # localize the plugin so we can get it later + local $CUR_PLUGIN = $p; + $sub->($p,@_); + } +} + +# "There's a good reason for this, I swear!" +# -- Sawyer X +# basically, if someone adds a hook to the app directly +# that needs to access a DSL that needs the current object +# (such as "plugin_setting"), +# that object needs to be available +# So: +# we override App's "add_hook" to provide a register a +# different hook callback, that closes over the plugin when +# it's available, relocalizes it when the callback runs and +# after localizing it, calls the original hook callback +{ + ## no critic; + no strict 'refs'; + no warnings 'redefine'; + my $orig_cb = Dancer2::Core::App->can('add_hook'); + $orig_cb and *{'Dancer2::Core::App::add_hook'} = sub { + my ( $app, $hook ) = @_; + + my $hook_code = Scalar::Util::blessed($hook) ? $hook->code : $hook->{code}; + my $plugin = $CUR_PLUGIN; + + $hook->{'code'} = sub { + local $CUR_PLUGIN = $plugin; + $hook_code->(@_); + }; + + $orig_cb->(@_); + }; +} + + +# define the exported 'plugin_keywords' +sub _exported_plugin_keywords{ + my( $plugin, $class ) = @_; + + return plugin_keywords => sub(@) { + while( my $name = shift @_ ) { + ## no critic + my $sub = is_coderef($_[0]) + ? shift @_ + : eval '\&'.$class."::" . ( ref $name ? $name->[0] : $name ); + $class->keywords->{$_} = $sub for ref $name ? @$name : $name; + } + } +} + +sub _exported_plugin_hooks { + my $class = shift; + return plugin_hooks => sub (@) { $class->add_hooks(@_) } +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Plugin - base class for Dancer2 plugins + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + +The plugin itself: + + package Dancer2::Plugin::Polite; + + use strict; + use warnings; + + use Dancer2::Plugin; + + has smiley => ( + is => 'ro', + default => sub { + $_[0]->config->{smiley} || ':-)' + } + ); + + plugin_keywords 'add_smileys'; + + sub BUILD { + my $plugin = shift; + + $plugin->app->add_hook( Dancer2::Core::Hook->new( + name => 'after', + code => sub { $_[0]->content( $_[0]->content . " ... please?" ) } + )); + + $plugin->app->add_route( + method => 'get', + regexp => '/goodbye', + code => sub { + my $app = shift; + 'farewell, ' . $app->request->params->{name}; + }, + ); + + } + + sub add_smileys { + my( $plugin, $text ) = @_; + + $text =~ s/ (?<= \. ) / $plugin->smiley /xeg; + + return $text; + } + + 1; + +then to load into the app: + + package MyApp; + + use strict; + use warnings; + + use Dancer2; + + BEGIN { # would usually be in config.yml + set plugins => { + Polite => { + smiley => '8-D', + }, + }; + } + + use Dancer2::Plugin::Polite; + + get '/' => sub { + add_smileys( 'make me a sandwich.' ); + }; + + 1; + +=head1 DESCRIPTION + +=head2 Writing the plugin + +=head3 C<use Dancer2::Plugin> + +The plugin must begin with + + use Dancer2::Plugin; + +which will turn the package into a L<Moo> class that inherits from L<Dancer2::Plugin>. The base class provides the plugin with +two attributes: C<app>, which is populated with the Dancer2 app object for which +the plugin is being initialized for, and C<config> which holds the plugin +section of the application configuration. + +=head3 Modifying the app at building time + +If the plugin needs to tinker with the application -- add routes or hooks, for example -- +it can do so within its C<BUILD()> function. + + sub BUILD { + my $plugin = shift; + + $plugin->app->add_route( ... ); + } + +=head3 Adding keywords + +=head4 Via C<plugin_keywords> + +Keywords that the plugin wishes to export to the Dancer2 app can be defined via the C<plugin_keywords> keyword: + + plugin_keywords qw/ + add_smileys + add_sad_kitten + /; + +Each of the keyword will resolve to the class method of the same name. When invoked as keyword, it'll be passed +the plugin object as its first argument. + + sub add_smileys { + my( $plugin, $text ) = @_; + + return join ' ', $text, $plugin->smiley; + } + + # and then in the app + + get '/' => sub { + add_smileys( "Hi there!" ); + }; + +You can also pass the functions directly to C<plugin_keywords>. + + plugin_keywords + add_smileys => sub { + my( $plugin, $text ) = @_; + + $text =~ s/ (?<= \. ) / $plugin->smiley /xeg; + + return $text; + }, + add_sad_kitten => sub { ... }; + +Or a mix of both styles. We're easy that way: + + plugin_keywords + add_smileys => sub { + my( $plugin, $text ) = @_; + + $text =~ s/ (?<= \. ) / $plugin->smiley /xeg; + + return $text; + }, + 'add_sad_kitten'; + + sub add_sad_kitten { + ...; + } + +If you want several keywords to be synonyms calling the same +function, you can list them in an arrayref. The first +function of the list is taken to be the "real" method to +link to the keywords. + + plugin_keywords [qw/ add_smileys add_happy_face /]; + + sub add_smileys { ... } + +Calls to C<plugin_keywords> are cumulative. + +=head4 Via the C<:PluginKeyword> function attribute + +For perl 5.12 and higher, keywords can also be defined by adding the C<:PluginKeyword> attribute +to the function you wish to export. + +For Perl 5.10, the export triggered by the sub attribute comes too late in the +game, and the keywords won't be exported in the application namespace. + + sub foo :PluginKeyword { ... } + + sub bar :PluginKeyword( baz quux ) { ... } + + # equivalent to + + sub foo { ... } + sub bar { ... } + + plugin_keywords 'foo', [ qw/ baz quux / ] => \&bar; + +=head4 For an attribute + +You can also turn an attribute of the plugin into a keyword. + + has foo => ( + is => 'ro', + plugin_keyword => 1, # keyword will be 'foo' + ); + + has bar => ( + is => 'ro', + plugin_keyword => 'quux', # keyword will be 'quux' + ); + + has baz => ( + is => 'ro', + plugin_keyword => [ 'baz', 'bazz' ], # keywords will be 'baz' and 'bazz' + ); + +=head3 Accessing the plugin configuration + +The plugin configuration is available via the C<config()> method. + + sub BUILD { + my $plugin = shift; + + if ( $plugin->config->{feeling_polite} ) { + $plugin->app->add_hook( Dancer2::Core::Hook->new( + name => 'after', + code => sub { $_[0]->content( $_[0]->content . " ... please?" ) } + )); + } + } + +=head3 Getting default values from config file + +Since initializing a plugin with either a default or a value passed via the configuration file, +like + + has smiley => ( + is => 'ro', + default => sub { + $_[0]->config->{smiley} || ':-)' + } + ); + +C<Dancer2::Plugin> allows for a C<from_config> key in the attribute definition. +Its value is the plugin configuration key that will be used to initialize the attribute. + +If it's given the value C<1>, the name of the attribute will be taken as the configuration key. + +Nested hash keys can also be referred to using a dot notation. + +If the plugin configuration has no value for the given key, the attribute default, if specified, will be honored. + +If the key is given a coderef as value, it's considered to be a C<default> value combo: + + has foo => ( + is => 'ro', + from_config => sub { 'my default' }, + ); + + + # equivalent to + has foo => ( + is => 'ro', + from_config => 'foo', + default => sub { 'my default' }, + ); + +For example: + + # in config.yml + + plugins: + Polite: + smiley: ':-)' + greeting: + casual: Hi! + formal: How do you do? + + + # in the plugin + + has smiley => ( # will be ':-)' + is => 'ro', + from_config => 1, + default => sub { ':-(' }, + ); + + has casual_greeting => ( # will be 'Hi!' + is => 'ro', + from_config => 'greeting.casual', + ); + + has apology => ( # will be 'sorry' + is => 'ro', + from_config => 'apology', + default => sub { 'sorry' }, + ) + + has closing => ( # will be 'See ya!' + is => 'ro', + from_config => sub { 'See ya!' }, + ); + +=head3 Config becomes immutable + +The plugin's C<config> attribute is loaded lazily on the first call to +C<config>. After this first call C<config> becomes immutable so you cannot +do the following in a test: + + use Dancer2; + use Dancer2::Plugin::FooBar; + + set plugins => { + FooBar => { + wibble => 1, # this is OK + }, + }; + + flibble(45); # plugin keyword called which causes config read + + set plugins => { + FooBar => { + wibble => 0, # this will NOT change plugin config + }, + }; + +=head3 Accessing the parent Dancer app + +If the plugin is instantiated within a Dancer app, it'll be +accessible via the method C<app()>. + + sub BUILD { + my $plugin = shift; + + $plugin->app->add_route( ... ); + } + +To use Dancer's DSL in your plugin: + + $self->dsl->debug( “Hi! I’m logging from your plugin!” ); + +See L<Dancer2::Manual/"DSL KEYWORDS"> for a full list of Dancer2 DSL. + +=head2 Using the plugin within the app + +A plugin is loaded via + + use Dancer2::Plugin::Polite; + +The plugin will assume that it's loading within a Dancer module and will +automatically register itself against its C<app()> and export its keywords +to the local namespace. If you don't want this to happen, specify that you +don't want anything imported via empty parentheses when C<use>ing the module: + + use Dancer2::Plugin::Polite (); + +=head2 Plugins using plugins + +It's easy to use plugins from within a plugin: + + package Dancer2::Plugin::SourPuss; + + use Dancer2::Plugin; + use Dancer2::Plugin::Polite; + + sub my_keyword { my $smiley = smiley(); } + + 1; + +This does not export C<smiley()> into your application - it is only available +from within your plugin. However, from the example above, you can wrap +DSL from other plugins and make it available from your plugin. + +=head2 Utilizing other plugins + +You can use the C<find_plugin> to locate other plugins loaded by the user, +in order to use them, or their information, directly: + + # MyApp.pm + use Dancer2; + use Dancer2::Plugin::Foo; + use Dancer2::Plugin::Bar; + + # Dancer2::Plugin::Bar; + ... + + sub my_keyword { + my $self = shift; + my $foo = $self->find_plugin('Dancer2::Plugin::Foo') + or $self->dsl->send_error('Could not find Foo'); + + return $foo->foo_keyword(...); + } + +=head2 Hooks + +New plugin hooks are declared via C<plugin_hooks>. + + plugin_hooks 'my_hook', 'my_other_hook'; + +Hooks are prefixed with C<plugin.plugin_name>. So the plugin +C<my_hook> coming from the plugin C<Dancer2::Plugin::MyPlugin> will have the hook name +C<plugin.myplugin.my_hook>. + +Hooks are executed within the plugin by calling them via the associated I<app>. + + $plugin->execute_plugin_hook( 'my_hook' ); + +You can also call any other hook if you provide the full name using the +C<execute_hook> method: + + $plugin->app->execute_hook( 'core.app.route_exception' ); + +Or using their alias: + + $plugin->app->execute_hook( 'on_route_exception' ); + +B<Note:> If your plugin consumes a plugin that declares any hooks, those hooks +are added to your application, even though DSL is not. + +=head2 Writing Test Gotchas + +=head3 Constructor for Dancer2::Plugin::Foo has been inlined and cannot be updated + +You'll usually get this one because you are defining both the plugin and app +in your test file, and the runtime creation of Moo's attributes happens after +the compile-time import voodoo dance. + +To get around this nightmare, wrap your plugin definition in a C<BEGIN> block. + + BEGIN { + package Dancer2::Plugin::Foo; + + use Dancer2::Plugin; + + has bar => ( + is => 'ro', + from_config => 1, + ); + + plugin_keywords qw/ bar /; + + } + + { + package MyApp; + + use Dancer2; + use Dancer2::Plugin::Foo; + + bar(); + } + +=head3 You cannot overwrite a locally defined method (bar) with a reader + +If you set an object attribute of your plugin to be a keyword as well, you need +to call C<plugin_keywords> after the attribute definition. + + package Dancer2::Plugin::Foo; + + use Dancer2::Plugin; + + has bar => ( + is => 'ro', + ); + + plugin_keywords 'bar'; + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Plugins.pod b/lib/Dancer2/Plugins.pod new file mode 100644 index 00000000..e1068b93 --- /dev/null +++ b/lib/Dancer2/Plugins.pod @@ -0,0 +1,136 @@ +package Dancer2::Plugins; +# ABSTRACT: Recommended Dancer2 plugins + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Plugins - Recommended Dancer2 plugins + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +Dancer2 aims to keep the core as small as possible, but there are a growing +number of useful plugins to add helpful features. + +This document provides a quick summary of some recommended plugins. + +=head2 Plugins + +=over 4 + +=item L<Dancer2::Plugin::Adapter> + +Wrap any simple class as a service for Dancer2. + +=item L<Dancer2::Plugin::Ajax> + +Provides easy way to add Ajax route handlers. + +=item L<Dancer2::Plugin::Auth::Tiny> + +Provides an extremely simple way of requiring that a user be logged in +before allowing access to certain routes. + +=item L<Dancer2::Plugin::BrowserDetect> + +Provides an easy to have info of the browser. keyword within your +Dancer application. + +=item L<Dancer2::Plugin::Cache::CHI> + +Provides caching for generated pages and/or arbitrary data. Uses L<CHI>, so +is backend-agnostic - caching can be done in memory, to files, using +Memcache, in a database, or any other method for which there is a +L<CHI::Driver> module. + +=item L<Dancer2::Plugin::Database> + +Provides easy database access via DBI, reading the DB connection details +from your app's config file, and taking care of ensuring the connection is +still valid and reconnecting if not (useful in persistent environments). +Just calling the C<database> keyword gives you a connected and working +database handle. It also provides some helpful keywords to make +inserting/updating data as simple as it should be. + +=item L<Dancer2::Plugin::DBIC> + +Provides easy access to DBIx::Class database virtualization. + +=item L<Dancer2::Plugin::Deferred> + +Provides a method for deferring a one-time message across a redirect. It is +similar to "flash" messages, but without the race conditions that can result +from multiple tabs in a browser or from AJAX requests. + +=item L<Dancer2::Plugin::Emailesque> + +Provides easy email-sending powered by Email::Send - simply call the +C<email> keyword. Email sending settings can be taken from your app's +config. + +=item L<Dancer2::Plugin::Feed> + +Provides an easy way to generate RSS or Atom feed. + +=item L<Dancer2::Plugin::Paginator> + +Dancer2 plugin for Paginator::Lite. + +=item L<Dancer2::Plugin::Queue> + +Provides a generic interface to a message queue. + +=item L<Dancer2::Plugin::Queue::MongoDB> + +A L<Dancer2::Plugin::Queue> using L<MongoDBx::Queue>. + +=item L<Dancer2::Plugin::REST> + +Makes writing RESTful web services easy. + +=item L<Dancer2::Plugin::RoutePodCoverage> + +Plugin to verify pod coverage in our app routes. + +=item L<Dancer2::Plugin::Syntax::GetPost> + +Provides very simple syntactic sugar to define a handler for GET and POST +requests. + +=back + +=head2 Session Engines + +=over 4 + +=item L<Dancer2::Session::Cookie> + +A session factory for Dancer2 that stores session state within a browser +cookie. + +=back + +More plugins are appearing on CPAN all the time - just search for +C<Dancer2::Plugin> to see what may have been released since this document +was last updated! + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Policy.pod b/lib/Dancer2/Policy.pod new file mode 100644 index 00000000..0c786c3d --- /dev/null +++ b/lib/Dancer2/Policy.pod @@ -0,0 +1,121 @@ +package Dancer2::Policy; +# ABSTRACT: Dancer core and community policy and standards of conduct + +use strict; +use warnings; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Policy - Dancer core and community policy and standards of conduct + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This document describes various policies (most notably, the standards +of conduct) for the Dancer core developers and broad community. + +This is what we expect from our community and ourselves and these are +the standards of behavior we set forth in order to make sure the community +remains a safe space for all of its members, without exception. + +=head1 STANDARDS OF CONDUCT + +These standards apply anywhere the community comes together as a group. +This includes, but is not limited to, the Dancer IRC channel, the Dancer +mailing list, Dancer hackathons, and Dancer conferences. + +=over 4 + +=item * + +Always be civil. + +=item * + +Heed the moderators. + +=item * + +Abuse is not tolerated. + +=back + +Civility is simple: stick to the facts while avoiding demeaning remarks and +sarcasm. It is not enough to be factual. You must also be civil. Responding +in kind to incivility is not acceptable. + +If the list moderators tell you that you are not being civil, carefully +consider how your words have appeared before responding in any way. You may +protest, but repeated protest in the face of a repeatedly reaffirmed decision +is not acceptable. + +Unacceptable behavior will result in a public and clearly identified warning. +Repeated unacceptable behavior will result in removal from the mailing list and +revocation of any commit bit. The first removal is for one month. Subsequent +removals will double in length. After six months with no warning, a user's ban +length is reset. Removals, like warnings, are public. + +The list of moderators consists of all active core developers. This includes, +in alphabetical order, Alberto Simões, David Precious, Jason Crome, Mickey +Nasriachi, Peter Mottram, Russell Jenkins, Sawyer X, Stefan Hornburg (Racke), +Steven Humphrey, and Yanick Champoux. + +This list might additionally grow to active members of the community who have +stepped up to help handle abusive behavior. If this should happen, this +document would be updated to include their names. + +Additionally, it's important to understand the self-regulating nature we +foster at the Dancer community. This means anyone and everyone in the +community - in the channel, on the list, at an event - has the ability to +call out unacceptable behavior and incivility to others in the community. + +Moderators are responsible for issuing warnings and take disciplinary actions, +but anyone may - and is encouraged - to publicly make note of unacceptable +treatment of others. + +As a core principle, abuse is never tolerated. One cannot berate, insult, +debase, deride, put down, or vilify anyone, or act towards anyone in a way +intending to hurt them. + +The community specifically considers as abuse any attempts to otherize anyone +by any individual characteristic, including, but not limited to, their +technical skill, knowledge or by their age, colour, disability, gender, +language, national or social origin, political or other opinion, race, +religion, sex, or sexual orientation. + +The community aims to maintain a safe space for everyone, in any forum it +has. If you ever feel this core principle has been compromised, you are strongly +urged to contact a moderator. We are always here. + +Remember, this is B<your> community, as much as it is anyone else's. + +=head1 CREDITS + +This policy has been adopted and adapted from the policy available for +the Perl language development, provided by B<p5p> (the Perl 5 Porters). + +The original inspiration policy document can be read at L<perlpolicy>. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Serializer/Dumper.pm b/lib/Dancer2/Serializer/Dumper.pm new file mode 100644 index 00000000..87e1c968 --- /dev/null +++ b/lib/Dancer2/Serializer/Dumper.pm @@ -0,0 +1,101 @@ +# ABSTRACT: Serializer for handling Dumper data + +package Dancer2::Serializer::Dumper; +$Dancer2::Serializer::Dumper::VERSION = '0.300000'; +use Moo; +use Carp 'croak'; +use Data::Dumper; +use Safe; + +with 'Dancer2::Core::Role::Serializer'; + +has '+content_type' => ( default => sub {'text/x-data-dumper'} ); + +# helpers +sub from_dumper { __PACKAGE__->deserialize(@_) } + +sub to_dumper { __PACKAGE__->serialize(@_) } + +# class definition +sub serialize { + my ( $self, $entity ) = @_; + + { + local $Data::Dumper::Purity = 1; + return Dumper($entity); + } +} + +sub deserialize { + my ( $self, $content ) = @_; + + my $cpt = Safe->new; + + my $res = $cpt->reval("my \$VAR1; $content"); + croak "unable to deserialize : $@" if $@; + return $res; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Serializer::Dumper - Serializer for handling Dumper data + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This is a serializer engine that allows you to turn Perl data structures into +L<Data::Dumper> output and vice-versa. + +=head1 ATTRIBUTES + +=head2 content_type + +Returns 'text/x-data-dumper' + +=head1 METHODS + +=head2 serialize($content) + +Serializes a Perl data structure into a Dumper string. + +=head2 deserialize($content) + +Deserialize a Dumper string into a Perl data structure. + +=head1 FUNCTIONS + +=head2 from_dumper($content) + +This is an helper available to transform a L<Data::Dumper> output to a Perl +data structures. + +=head2 to_dumper($content) + +This is an helper available to transform a Perl data structures to a +L<Data::Dumper> output. + +Calling this function will B<not> trigger the serialization's hooks. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Serializer/JSON.pm b/lib/Dancer2/Serializer/JSON.pm new file mode 100644 index 00000000..66e059ee --- /dev/null +++ b/lib/Dancer2/Serializer/JSON.pm @@ -0,0 +1,153 @@ +package Dancer2::Serializer::JSON; +# ABSTRACT: Serializer for handling JSON data +$Dancer2::Serializer::JSON::VERSION = '0.300000'; +use Moo; +use JSON::MaybeXS (); +use Scalar::Util 'blessed'; + +with 'Dancer2::Core::Role::Serializer'; + +has '+content_type' => ( default => sub {'application/json'} ); + +# helpers +sub from_json { __PACKAGE__->deserialize(@_) } + +sub to_json { __PACKAGE__->serialize(@_) } + +sub decode_json { + my ( $entity ) = @_; + + JSON::MaybeXS::decode_json($entity); +} + +sub encode_json { + my ( $entity ) = @_; + + JSON::MaybeXS::encode_json($entity); +} + +# class definition +sub serialize { + my ( $self, $entity, $options ) = @_; + + my $config = blessed $self ? $self->config : {}; + + foreach (keys %$config) { + $options->{$_} = $config->{$_} unless exists $options->{$_}; + } + + $options->{utf8} = 1 if !defined $options->{utf8}; + JSON::MaybeXS->new($options)->encode($entity); +} + +sub deserialize { + my ( $self, $entity, $options ) = @_; + + $options->{utf8} = 1 if !defined $options->{utf8}; + JSON::MaybeXS->new($options)->decode($entity); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Serializer::JSON - Serializer for handling JSON data + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This is a serializer engine that allows you to turn Perl data structures into +JSON output and vice-versa. + +=head1 ATTRIBUTES + +=head2 content_type + +Returns 'application/json' + +=head1 METHODS + +=head2 serialize($content) + +Serializes a Perl data structure into a JSON string. + +=head2 deserialize($content) + +Deserializes a JSON string into a Perl data structure. + +=head1 FUNCTIONS + +=head2 from_json($content, \%options) + +This is an helper available to transform a JSON data structure to a Perl data structures. + +=head2 to_json($content, \%options) + +This is an helper available to transform a Perl data structure to JSON. + +Calling this function will B<not> trigger the serialization's hooks. + +=head2 Configuring the JSON Serializer using C<set engines> + +The JSON serializer options can be configured via C<set engines>. The most +common settings are: + +=over 4 + +=item allow_nonref + +Ignore non-ref scalars returned from handlers. With this set the "Hello, World!" +handler returning a string will be dealt with properly. + +=back + +Set engines should be called prior to setting JSON as the serializer: + + set engines => + { + serializer => + { + JSON => + { + allow_nonref => 1 + }, + } + }; + + set serializer => 'JSON'; + set content_type => 'application/json'; + +=head2 Returning non-JSON data. + +Handlers can return non-JSON via C<send_as>, which overrides the default serializer: + + get '/' => + sub + { + send_as html => + q{Welcome to the root of all evil...<br>step into my office.} + }; + +Any other non-JSON returned format supported by 'send_as' can be used. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Serializer/Mutable.pm b/lib/Dancer2/Serializer/Mutable.pm new file mode 100644 index 00000000..fc36be5f --- /dev/null +++ b/lib/Dancer2/Serializer/Mutable.pm @@ -0,0 +1,246 @@ +package Dancer2::Serializer::Mutable; +# ABSTRACT: Serialize and deserialize content based on HTTP header +$Dancer2::Serializer::Mutable::VERSION = '0.300000'; +use Moo; +use Carp 'croak'; +use Encode; +with 'Dancer2::Core::Role::Serializer'; + +use constant DEFAULT_CONTENT_TYPE => 'application/json'; + +has '+content_type' => ( default => DEFAULT_CONTENT_TYPE() ); + +my $serializer = { + 'YAML' => { + to => sub { Dancer2::Core::DSL::to_yaml(@_) }, + from => sub { Dancer2::Core::DSL::from_yaml(@_) }, + }, + 'Dumper' => { + to => sub { Dancer2::Core::DSL::to_dumper(@_) }, + from => sub { Dancer2::Core::DSL::from_dumper(@_) }, + }, + 'JSON' => { + to => sub { Dancer2::Core::DSL::to_json(@_) }, + from => sub { Dancer2::Core::DSL::from_json(@_) }, + }, +}; + +has mapping => ( + is => 'ro', + lazy => 1, + default => sub { + my $self = shift; + + if ( my $mapping = $self->config->{mapping} ) { + + # initialize non-default serializers + for my $s ( values %$mapping ) { + # TODO allow for arguments via the config + next if $serializer->{$s}; + my $serializer_object = ('Dancer2::Serializer::'.$s)->new; + $serializer->{$s} = { + from => sub { shift; $serializer_object->deserialize(@_) }, + to => sub { shift; $serializer_object->serialize(@_) }, + }; + } + + return $mapping; + } + + + return { + 'text/x-yaml' => 'YAML', + 'text/html' => 'YAML', + 'text/x-data-dumper' => 'Dumper', + 'text/x-json' => 'JSON', + 'application/json' => 'JSON', + } + }, +); + +sub serialize { + my ( $self, $entity ) = @_; + + # Look for valid format in the headers + my $format = $self->_get_content_type('accept'); + + # Match format with a serializer and return + $format and return $serializer->{$format}{'to'}->( + $self, $entity + ); + + # If none is found then just return the entity without change + return $entity; +} + +sub deserialize { + my ( $self, $content ) = @_; + + my $format = $self->_get_content_type('content_type'); + $format and return $serializer->{$format}{'from'}->($self, $content); + + return $content; +} + +sub _get_content_type { + my ($self, $header) = @_; + + if ( $self->has_request ) { + # Search for the first HTTP header variable which specifies + # supported content. Both content_type and accept are checked + # for backwards compatibility. + foreach my $method ( $header, qw<content_type accept> ) { + if ( my $value = $self->request->header($method) ) { + if ( my $serializer = $self->mapping->{$value} ) { + $self->set_content_type($value); + return $serializer; + } + } + } + } + + # If none if found, return the default, 'JSON'. + $self->set_content_type( DEFAULT_CONTENT_TYPE() ); + return 'JSON'; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Serializer::Mutable - Serialize and deserialize content based on HTTP header + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + # in config.yml + serializer: Mutable + + engines: + serializer: + Mutable: + mapping: + 'text/x-yaml' : YAML + 'text/html' : YAML + 'text/x-data-dumper' : Dumper + 'text/x-json' : JSON + 'application/json' : JSON + + # in the app + put '/something' => sub { + # deserialized from request + my $name = param( 'name' ); + + ... + + # will be serialized to the most + # fitting format + return { message => "user $name added" }; + }; + +=head1 DESCRIPTION + +This serializer will try find the best (de)serializer for a given request. +For this, it will pick the first valid content type found from the following list +and use its related serializer. + +=over + +=item + +The B<content_type> from the request headers + +=item + +the B<accept> from the request headers + +=item + +The default is B<application/json> + +=back + +The content-type/serializer mapping that C<Dancer2::Serializer::Mutable> +uses is + + serializer | content types + ---------------------------------------------------------- + Dancer2::Serializer::YAML | text/x-yaml, text/html + Dancer2::Serializer::Dumper | text/x-data-dumper + Dancer2::Serializer::JSON | text/x-json, application/json + +A different mapping can be provided via the config file. For example, +the default mapping would be configured as + + engines: + serializer: + Mutable: + mapping: + 'text/x-yaml' : YAML + 'text/html' : YAML + 'text/x-data-dumper' : Dumper + 'text/x-json' : JSON + 'application/json' : JSON + +The keys of the mapping are the content-types to serialize, +and the values the serializers to use. Serialization for C<YAML>, C<Dumper> +and C<JSON> are done using internal Dancer mechanisms. Any other serializer will +be taken to be as Dancer2 serialization class (minus the C<Dancer2::Serializer::> prefix) +and an instance of it will be used +to serialize/deserialize data. For example, adding L<Dancer2::Serializer::XML> +to the mapping would be: + + engines: + serializer: + Mutable: + mapping: + 'text/x-yaml' : YAML + 'text/html' : YAML + 'text/x-data-dumper' : Dumper + 'text/x-json' : JSON + 'text/xml' : XML + +=head2 INTERNAL METHODS + +The following methods are used internally by C<Dancer2> and are not made +accessible via the DSL. + +=head2 serialize + +Serialize a data structure. The format it is serialized to is determined +automatically as described above. It can be one of YAML, Dumper, JSON, defaulting +to JSON if there's no clear preference from the request. + +=head2 deserialize + +Deserialize the provided serialized data to a data structure. The type of +serialization format depends on the request's content-type. For now, it can +be one of YAML, Dumper, JSON. + +=head2 content_type + +Returns the content-type that was used during the last C<serialize> / +C<deserialize> call. B<WARNING> : you must call C<serialize> / C<deserialize> +before calling C<content_type>. Otherwise the return value will be C<undef>. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Serializer/YAML.pm b/lib/Dancer2/Serializer/YAML.pm new file mode 100644 index 00000000..8fe50a3f --- /dev/null +++ b/lib/Dancer2/Serializer/YAML.pm @@ -0,0 +1,91 @@ +package Dancer2::Serializer::YAML; +# ABSTRACT: Serializer for handling YAML data +$Dancer2::Serializer::YAML::VERSION = '0.300000'; +use Moo; +use Carp 'croak'; +use Encode; +use Module::Runtime 'use_module'; + +with 'Dancer2::Core::Role::Serializer'; + +has '+content_type' => ( default => sub {'text/x-yaml'} ); + +# helpers +sub from_yaml { __PACKAGE__->deserialize(@_) } + +sub to_yaml { __PACKAGE__->serialize(@_) } + +# class definition +sub BUILD { use_module('YAML') } + +sub serialize { + my ( $self, $entity ) = @_; + encode('UTF-8', YAML::Dump($entity)); +} + +sub deserialize { + my ( $self, $content ) = @_; + YAML::Load(decode('UTF-8', $content)); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Serializer::YAML - Serializer for handling YAML data + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This is a serializer engine that allows you to turn Perl data structures into +YAML output and vice-versa. + +=head1 ATTRIBUTES + +=head2 content_type + +Returns 'text/x-yaml' + +=head1 METHODS + +=head2 serialize($content) + +Serializes a data structure to a YAML structure. + +=head2 deserialize($content) + +Deserializes a YAML structure to a data structure. + +=head1 FUNCTIONS + +=head2 fom_yaml($content) + +This is an helper available to transform a YAML data structure to a Perl data structures. + +=head2 to_yaml($content) + +This is an helper available to transform a Perl data structure to YAML. + +Calling this function will B<not> trigger the serialization's hooks. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Session/Simple.pm b/lib/Dancer2/Session/Simple.pm new file mode 100644 index 00000000..616c7840 --- /dev/null +++ b/lib/Dancer2/Session/Simple.pm @@ -0,0 +1,93 @@ +package Dancer2::Session::Simple; +# ABSTRACT: in-memory session backend for Dancer2 +$Dancer2::Session::Simple::VERSION = '0.300000'; +use Moo; +use Dancer2::Core::Types; +use Carp; + +with 'Dancer2::Core::Role::SessionFactory'; + +# The singleton that contains all the session objects created +my $SESSIONS = {}; + +sub _sessions { + my ($self) = @_; + return [ keys %{$SESSIONS} ]; +} + +sub _retrieve { + my ( $class, $id ) = @_; + my $s = $SESSIONS->{$id}; + + croak "Invalid session ID: $id" + if !defined $s; + + return $s; +} + +sub _change_id { + my ( $class, $old_id, $new_id ) = @_; + + $SESSIONS->{$new_id} = $class->_retrieve($old_id); + delete $SESSIONS->{$old_id}; +} + +sub _destroy { + my ( $class, $id ) = @_; + delete $SESSIONS->{$id}; +} + +sub _flush { + my ( $class, $id, $data ) = @_; + $SESSIONS->{$id} = $data; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Session::Simple - in-memory session backend for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This module implements a very simple session backend, holding all session data +in memory. This means that sessions are volatile, and no longer exist when the +process exits. This module is likely to be most useful for testing purposes. + +=head1 DISCLAIMER + +This session factory should not be used in production and is only for +single-process application workers. As the sessions objects are stored +in-memory, they cannot be shared among multiple workers. + +=head1 CONFIGURATION + +The setting B<session> should be set to C<Simple> in order to use this session +engine in a Dancer2 application. + +=head1 SEE ALSO + +See L<Dancer2::Core::Session> for details about session usage in route handlers. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Session/YAML.pm b/lib/Dancer2/Session/YAML.pm new file mode 100644 index 00000000..fe0ec8fc --- /dev/null +++ b/lib/Dancer2/Session/YAML.pm @@ -0,0 +1,95 @@ +package Dancer2::Session::YAML; +$Dancer2::Session::YAML::VERSION = '0.300000'; +# ABSTRACT: YAML-file-based session backend for Dancer2 + +use Moo; +use Dancer2::Core::Types; +use YAML; + +has _suffix => ( + is => 'ro', + isa => Str, + default => sub {'.yml'}, +); + +with 'Dancer2::Core::Role::SessionFactory::File'; + +sub _freeze_to_handle { + my ( $self, $fh, $data ) = @_; + print {$fh} YAML::Dump($data); + return; +} + +sub _thaw_from_handle { + my ( $self, $fh ) = @_; + return YAML::LoadFile($fh); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Session::YAML - YAML-file-based session backend for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 DESCRIPTION + +This module implements a session engine based on YAML files. Session are stored +in a I<session_dir> as YAML files. The idea behind this module was to provide a +human-readable session storage for the developer. + +This backend is intended to be used in development environments, when digging +inside a session can be useful. + +This backend can perfectly be used in production environments, but two things +should be kept in mind: The content of the session files is in plain text, and +the session files should be purged by a CRON job. + +=head1 CONFIGURATION + +The setting B<session> should be set to C<YAML> in order to use this session +engine in a Dancer2 application. + +Files will be stored to the value of the setting C<session_dir>, whose default +value is C<appdir/sessions>. + +Here is an example configuration that use this session engine and stores session +files in /tmp/dancer-sessions + + session: "YAML" + + engines: + session: + YAML: + session_dir: "/tmp/dancer-sessions" + cookie_duration: 3600 # Default cookie timeout in seconds + +=head1 DEPENDENCY + +This module depends on L<YAML>. + +=head1 SEE ALSO + +See L<Dancer2::Core::Session> for details about session usage in route handlers. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Template/Implementation/ForkedTiny.pm b/lib/Dancer2/Template/Implementation/ForkedTiny.pm new file mode 100644 index 00000000..07bcb6e5 --- /dev/null +++ b/lib/Dancer2/Template/Implementation/ForkedTiny.pm @@ -0,0 +1,390 @@ +package Dancer2::Template::Implementation::ForkedTiny; +$Dancer2::Template::Implementation::ForkedTiny::VERSION = '0.300000'; +# ABSTRACT: Dancer2 own implementation of Template::Tiny + +use 5.00503; +use strict; +no warnings; +use Ref::Util qw<is_arrayref is_coderef is_plain_hashref>; + +# Evaluatable expression +my $EXPR = qr/ [a-z_][\w.]* /xs; + +sub new { + my $self = bless { + start_tag => '[%', + end_tag => '%]', + @_[ 1 .. $#_ ] + }, + $_[0]; + +# Opening tag including whitespace chomping rules + my $LEFT = $self->{LEFT} = qr/ + (?: + (?: (?:^|\n) [ \t]* )? \Q$self->{start_tag}\E\- + | + \Q$self->{start_tag}\E \+? + ) \s* +/xs; + +# Closing %] tag including whitespace chomping rules + my $RIGHT = $self->{RIGHT} = qr/ + \s* (?: + \+? \Q$self->{end_tag}\E + | + \-\Q$self->{end_tag}\E (?: [ \t]* \n )? + ) +/xs; + +# Preparsing run for nesting tags + $self->{PREPARSE} = qr/ + $LEFT ( IF | UNLESS | FOREACH ) \s+ + ( + (?: \S+ \s+ IN \s+ )? + \S+ ) + $RIGHT + (?! + .*? + $LEFT (?: IF | UNLESS | FOREACH ) \b + ) + ( .*? ) + (?: + $LEFT ELSE $RIGHT + (?! + .*? + $LEFT (?: IF | UNLESS | FOREACH ) \b + ) + ( .+? ) + )? + $LEFT END $RIGHT +/xs; + + $self->{CONDITION} = qr/ + \Q$self->{start_tag}\E\s + ( ([IUF])\d+ ) \s+ + (?: + ([a-z]\w*) \s+ IN \s+ + )? + ( $EXPR ) + \s\Q$self->{end_tag}\E + ( .*? ) + (?: + \Q$self->{start_tag}\E\s \1 \s\Q$self->{end_tag}\E + ( .+? ) + )? + \Q$self->{start_tag}\E\s \1 \s\Q$self->{end_tag}\E +/xs; + + $self; +} + +# Copy and modify +sub preprocess { + my $self = shift; + my $text = shift; + $self->_preprocess( \$text ); + return $text; +} + +sub process { + my $self = shift; + my $copy = ${ shift() }; + my $stash = shift || {}; + + local $@ = ''; + local $^W = 0; + + # Preprocess to establish unique matching tag sets + $self->_preprocess( \$copy ); + + # Process down the nested tree of conditions + my $result = $self->_process( $stash, $copy ); + if (@_) { + ${ $_[0] } = $result; + } + elsif ( defined wantarray ) { + require Carp; + Carp::carp( + 'Returning of template results is deprecated in Template::Tiny 0.11' + ); + return $result; + } + else { + print $result; + } +} + + +###################################################################### +# Support Methods + +# The only reason this is a standalone is so we can +# do more in-depth testing. +sub _preprocess { + my $self = shift; + my $copy = shift; + + # Preprocess to establish unique matching tag sets + my $id = 0; + 1 while $$copy =~ s/ + $self->{PREPARSE} + / + my $tag = substr($1, 0, 1) . ++$id; + "\[\% $tag $2 \%\]$3\[\% $tag \%\]" + . (defined($4) ? "$4\[\% $tag \%\]" : ''); + /sex; +} + +sub _process { + my ( $self, $stash, $text ) = @_; + + $text =~ s/ + $self->{CONDITION} + / + ($2 eq 'F') + ? $self->_foreach($stash, $3, $4, $5) + : eval { + $2 eq 'U' + xor + !! # Force boolification + $self->_expression($stash, $4) + } + ? $self->_process($stash, $5) + : $self->_process($stash, $6) + /gsex; + + # Resolve expressions + $text =~ s/ + $self->{LEFT} ( $EXPR ) $self->{RIGHT} + / + eval { + $self->_expression($stash, $1) + . '' # Force stringification + } + /gsex; + + # Trim the document + $text =~ s/^\s*(.+?)\s*\z/$1/s if $self->{TRIM}; + + return $text; +} + +# Special handling for foreach +sub _foreach { + my ( $self, $stash, $term, $expr, $text ) = @_; + + # Resolve the expression + my $list = $self->_expression( $stash, $expr ); + is_arrayref($list) or return ''; + + # Iterate + return join '', + map { $self->_process( { %$stash, $term => $_ }, $text ) } @$list; +} + +# Evaluates a stash expression +sub _expression { + my $cursor = $_[1]; + my @path = split /\./, $_[2]; + foreach (@path) { + + # Support for private keys + return if substr( $_, 0, 1 ) eq '_'; + + # Split by data type + ref $cursor or return ''; + if ( is_arrayref($cursor) ) { + return '' unless /^(?:0|[0-9]\d*)\z/; + $cursor = $cursor->[$_]; + } + elsif ( is_plain_hashref($cursor) ) { + $cursor = $cursor->{$_}; + } + else { + $cursor = $cursor->$_(); + } + } + + # If the last expression is a CodeRef, execute it + is_coderef($cursor) + and $cursor = $cursor->(); + return $cursor; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Template::Implementation::ForkedTiny - Dancer2 own implementation of Template::Tiny + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + my $template = Dancer2::Template::Implementation::ForkedTiny->new( + TRIM => 1, + ); + + # Print the template results to STDOUT + $template->process( <<'END_TEMPLATE', { foo => 'World' } ); + Hello [% foo %]! + END_TEMPLATE + +=head1 DESCRIPTION + +B<Dancer2::Template::Implementation::ForkedTiny> is a reimplementation of a subset of the functionality from +L<Template> Toolkit in as few lines of code as possible. + +It is intended for use in light-usage, low-memory, or low-cpu templating +situations, where you may need to upgrade to the full feature set in the +future, or if you want the retain the familiarity of TT-style templates. + +For the subset of functionality it implements, it has fully-compatible template +and stash API. All templates used with B<Dancer2::Template::Implementation::ForkedTiny> should be able to be +transparently upgraded to full Template Toolkit. + +Unlike Template Toolkit, B<Dancer2::Template::Implementation::ForkedTiny> will process templates without a +compile phase (but despite this is still quicker, owing to heavy use of +the Perl regular expression engine. + +=head2 SUPPORTED USAGE + +By default, the C<[% %]> tag style is used. You can change the start tag and +end tag by specifying them at object creation : + + my $template = Dancer2::Template::Implementation::ForkedTiny->new( + start_tag => '<%', + end_tag => '%>, + ); + +In the rest of the documentation, C<[% %]> will be used, but it can be of +course your specified start / end tags. + +Both the C<[%+ +%]> style explicit whitespace and the C<[%- -%]> style +explicit chomp B<are> support, although the C<[%+ +%]> version is unneeded +in practice as B<Dancer2::Template::Implementation::ForkedTiny> does not support default-enabled C<PRE_CHOMP> +or C<POST_CHOMP>. + +Variable expressions in the form C<[% foo.bar.baz %]> B<are> supported. + +Appropriate simple behaviours for C<ARRAY> references, C<HASH> references and +objects are supported. "VMethods" such as [% array.length %] are B<not> +supported at this time. + +If the resulting expression is a CodeRef, it'll be evaluated. + +C<IF>, C<ELSE> and C<UNLESS> conditional blocks B<are> supported, but only with +simple C<[% foo.bar.baz %]> conditions. + +Support for looping (or rather iteration) is available in simple +C<[% FOREACH item IN list %]> form B<is> supported. Other loop structures are +B<not> supported. Because support for arbitrary or infinite looping is not +available, B<Dancer2::Template::Implementation::ForkedTiny> templates are not turing complete. This is +intentional. + +All of the four supported control structures C<IF>/C<ELSE>/C<UNLESS>/C<FOREACH> +can be nested to arbitrary depth. + +The treatment of C<_private> hash and method keys is compatible with +L<Template> Toolkit, returning null or false rather than the actual content +of the hash key or method. + +Anything beyond the above is currently out of scope. + +=head1 NAME + +Dancer2::Template::Implementation::ForkedTiny - Template Toolkit reimplemented in as little code as possible, forked from Template::Tiny + +=head1 METHODS + +=head2 new + + my $template = Dancer2::Template::Implementation::ForkedTiny->new( + TRIM => 1, + ); + +The C<new> constructor is provided for compatibility with Template Toolkit. + +The only parameter it currently supports is C<TRIM> (which removes leading +and trailing whitespace from processed templates). + +Additional parameters can be provided without error, but will be ignored. + +=head2 process + + # DEPRECATED: Return template results (emits a warning) + my $text = $template->process( \$input, $vars ); + + # Print template results to STDOUT + $template->process( \$input, $vars ); + + # Generate template results into a variable + my $output = ''; + $template->process( \$input, $vars, \$output ); + +The C<process> method is called to process a template. + +The first parameter is a reference to a text string containing the template +text. A reference to a hash may be passed as the second parameter containing +definitions of template variables. + +If a third parameter is provided, it must be a scalar reference to be +populated with the output of the template. + +For a limited amount of time, the old deprecated interface will continue to +be supported. If C<process> is called without a third parameter, and in +scalar or list contest, the template results will be returned to the caller. + +If C<process> is called without a third parameter, and in void context, the +template results will be C<print()>ed to the currently selected file handle +(probably C<STDOUT>) for compatibility with L<Template>. + +=head1 SUPPORT + +Bugs should be reported via the CPAN bug tracker at + +L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Template-Tiny> + +For other issues, or commercial enhancement or support, contact the author. + +=head1 AUTHOR + +Adam Kennedy E<lt>adamk@cpan.orgE<gt> + +Forked and improved by Damien Krotkine E<lt>dams@cpan.orgE<gt> + +=head1 SEE ALSO + +L<Config::Tiny>, L<CSS::Tiny>, L<YAML::Tiny> + +=head1 COPYRIGHT + +Copyright 2009 - 2011 Adam Kennedy. +Copyright 2012 Damien Krotkine. + +This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +The full text of the license can be found in the +LICENSE file included with this module. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Template/Simple.pm b/lib/Dancer2/Template/Simple.pm new file mode 100644 index 00000000..817f9d72 --- /dev/null +++ b/lib/Dancer2/Template/Simple.pm @@ -0,0 +1,220 @@ +package Dancer2::Template::Simple; +# ABSTRACT: Pure Perl 5 template engine for Dancer2 +$Dancer2::Template::Simple::VERSION = '0.300000'; +use Moo; +use Dancer2::FileUtils 'read_file_content'; +use Ref::Util qw<is_arrayref is_coderef is_plain_hashref>; + +with 'Dancer2::Core::Role::Template'; + +has start_tag => ( + is => 'rw', + default => sub {'<%'}, +); + +has stop_tag => ( + is => 'rw', + default => sub {'%>'}, +); + +sub BUILD { + my $self = shift; + my $settings = $self->config; + + $settings->{$_} and $self->$_( $settings->{$_} ) + for qw/ start_tag stop_tag /; +} + +sub render { + my ( $self, $template, $tokens ) = @_; + my $content; + + $content = read_file_content($template); + $content = $self->parse_branches( $content, $tokens ); + + return $content; +} + +sub parse_branches { + my ( $self, $content, $tokens ) = @_; + my ( $start, $stop ) = ( $self->start_tag, $self->stop_tag ); + + my @buffer; + my $prefix = ""; + my $should_bufferize = 1; + my $bufferize_if_token = 0; + +# $content =~ s/\Q${start}\E(\S)/${start} $1/sg; +# $content =~ s/(\S)\Q${stop}\E/$1 ${stop}/sg; + + # we get here a list of tokens without the start/stop tags + my @full = split( /\Q$start\E\s*(.*?)\s*\Q$stop\E/, $content ); + + # and here a list of tokens without variables + my @flat = split( /\Q$start\E\s*.*?\s*\Q$stop\E/, $content ); + + # eg: for 'foo=<% var %>' + # @full = ('foo=', 'var') + # @flat = ('foo=') + + my $flat_index = 0; + my $full_index = 0; + for my $word (@full) { + + # flat word, nothing to do + if ( defined $flat[$flat_index] + && ( $flat[$flat_index] eq $full[$full_index] ) ) + { + push @buffer, $word if $should_bufferize; + $flat_index++; + $full_index++; + next; + } + + my @to_parse = ($word); + @to_parse = split( /\s+/, $word ) if $word =~ /\s+/; + + for my $w (@to_parse) { + + if ( $w eq 'if' ) { + $bufferize_if_token = 1; + } + elsif ( $w eq 'else' ) { + $should_bufferize = !$should_bufferize; + } + elsif ( $w eq 'end' ) { + $should_bufferize = 1; + } + elsif ($bufferize_if_token) { + my $bool = _find_value_from_token_name( $w, $tokens ); + $should_bufferize = _interpolate_value($bool) ? 1 : 0; + $bufferize_if_token = 0; + } + elsif ($should_bufferize) { + my $val = + _interpolate_value( + _find_value_from_token_name( $w, $tokens ) ); + push @buffer, $val; + } + } + + $full_index++; + } + + return join "", @buffer; +} + + +sub _find_value_from_token_name { + my ( $key, $tokens ) = @_; + my $value = undef; + + my @elements = split /\./, $key; + foreach my $e (@elements) { + if ( not defined $value ) { + $value = $tokens->{$e}; + } + elsif ( is_plain_hashref($value) ) { + $value = $value->{$e}; + } + elsif ( ref($value) ) { + local $@; + eval { $value = $value->$e }; + $value = "" if $@; + } + } + return $value; +} + +sub _interpolate_value { + my ($value) = @_; + if ( is_coderef($value) ) { + local $@; + eval { $value = $value->() }; + $value = "" if $@; + } + elsif ( is_arrayref($value) ) { + $value = "@{$value}"; + } + + $value = "" if not defined $value; + return $value; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Template::Simple - Pure Perl 5 template engine for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + +To use this engine, you may configure L<Dancer2> via C<config.yaml>: + + template: simple + +=head1 DESCRIPTION + +This template engine is provided as a default one for the Dancer2 micro +framework. + +This template engine should be fine for development purposes but is not a +powerful one, it's written in pure Perl and has no C bindings to accelerate the +template processing. + +If you want to power an application with Dancer2 in production environment, it's +strongly advised to switch to L<Dancer2::Template::TemplateToolkit>. + +=head1 METHODS + +=head2 render($template, \%tokens) + +Renders the template. The first arg is a filename for the template file +or a reference to a string that contains the template. The second arg +is a hashref for the tokens that you wish to pass to +L<Template::Toolkit> for rendering. + +=head1 SYNTAX + +A template written for C<Dancer2::Template::Simple> should be working just fine +with L<Dancer2::Template::TemplateToolkit>. The opposite is not true though. + +=over 4 + +=item B<variables> + +To interpolate a variable in the template, use the following syntax: + + <% var1 %> + +If B<var1> exists in the tokens hash given, its value will be written there. + +=back + +=head1 SEE ALSO + +L<Dancer2>, L<Dancer2::Core::Role::Template>, +L<Dancer2::Template::TemplateToolkit>. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Template/TemplateToolkit.pm b/lib/Dancer2/Template/TemplateToolkit.pm new file mode 100644 index 00000000..f5ab9560 --- /dev/null +++ b/lib/Dancer2/Template/TemplateToolkit.pm @@ -0,0 +1,245 @@ +# ABSTRACT: Template toolkit engine for Dancer2 + +package Dancer2::Template::TemplateToolkit; +$Dancer2::Template::TemplateToolkit::VERSION = '0.300000'; +use Moo; +use Carp qw<croak>; +use Dancer2::Core::Types; +use Dancer2::FileUtils qw<path>; +use Scalar::Util (); +use Template; + +with 'Dancer2::Core::Role::Template'; + +has '+engine' => ( isa => InstanceOf ['Template'], ); + +sub _build_engine { + my $self = shift; + my $charset = $self->charset; + my %tt_config = ( + ANYCASE => 1, + ABSOLUTE => 1, + length($charset) ? ( ENCODING => $charset ) : (), + %{ $self->config }, + ); + + my $start_tag = $self->config->{'start_tag'}; + my $stop_tag = $self->config->{'stop_tag'} || $self->config->{end_tag}; + $tt_config{'START_TAG'} = $start_tag + if defined $start_tag && $start_tag ne '[%'; + $tt_config{'END_TAG'} = $stop_tag + if defined $stop_tag && $stop_tag ne '%]'; + + Scalar::Util::weaken( my $ttt = $self ); + my $include_path = $self->config->{include_path}; + $tt_config{'INCLUDE_PATH'} ||= [ + ( defined $include_path ? $include_path : () ), + sub { [ $ttt->views ] }, + ]; + + my $tt = Template->new(%tt_config); + $Template::Stash::PRIVATE = undef if $self->config->{show_private_variables}; + return $tt; +} + +sub render { + my ( $self, $template, $tokens ) = @_; + + my $content = ''; + my $charset = $self->charset; + my @options = length($charset) ? ( binmode => ":encoding($charset)" ) : (); + $self->engine->process( $template, $tokens, \$content, @options ) + or croak 'Failed to render template: ' . $self->engine->error; + + return $content; +} + +# Override *_pathname methods from Dancer2::Core::Role::Template +# Let TT2 do the concatenation of paths to template names. +# +# TT2 will look in a its INCLUDE_PATH for templates. +# Typically $self->views is an absolute path, and we set ABSOLUTE=> 1 above. +# In that case TT2 does NOT iterate through what is set for INCLUDE_PATH +# However, if its not absolute, we want to allow TT2 iterate through the +# its INCLUDE_PATH, which we set to be $self->views. + +sub view_pathname { + my ( $self, $view ) = @_; + return $self->_template_name($view); +} + +sub layout_pathname { + my ( $self, $layout ) = @_; + return path( + $self->layout_dir, + $self->_template_name($layout), + ); +} + +sub pathname_exists { + my ( $self, $pathname ) = @_; + my $exists = eval { + # dies if pathname can not be found via TT2's INCLUDE_PATH search + $self->engine->service->context->template( $pathname ); + 1; + }; + $self->log_cb->( debug => $@ ) if ! $exists; + return $exists; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Template::TemplateToolkit - Template toolkit engine for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + +To use this engine, you may configure L<Dancer2> via C<config.yaml>: + + template: "template_toolkit" + +Or you may also change the rendering engine on a per-route basis by +setting it manually with C<set>: + + # code code code + set template => 'template_toolkit'; + +Most configuration variables available when creating a new instance of a +L<Template>::Toolkit object can be declared inside the template toolkit +section on the engines configuration in your config.yml file. For example: + + engines: + template: + template_toolkit: + start_tag: '<%' + end_tag: '%>' + +(Note: C<start_tag> and C<end_tag> are regexes. If you want to use PHP-style +tags, you will need to list them as C<< <\? >> and C<< \?> >>.) +See L<Template::Manual::Config> for the configuration variables. + +In addition to the standard configuration variables, the option C<show_private_variables> +is also available. Template::Toolkit, by default, does not render private variables +(the ones starting with an underscore). If in your project it gets easier to disable +this feature than changing variable names, add this option to your configuration. + + show_private_variables: true + +B<Warning:> Given the way Template::Toolkit implements this option, different Dancer2 +applications running within the same interpreter will share this option! + +=head1 DESCRIPTION + +This template engine allows you to use L<Template>::Toolkit in L<Dancer2>. + +=head1 METHODS + +=head2 render($template, \%tokens) + +Renders the template. The first arg is a filename for the template file +or a reference to a string that contains the template. The second arg +is a hashref for the tokens that you wish to pass to +L<Template::Toolkit> for rendering. + +=head1 ADVANCED CUSTOMIZATION + +L<Template>::Toolkit allows you to replace certain parts, like the internal +STASH (L<Template::Stash>). In order to do that, one usually passes an object of another +implementation such as L<Template::Stash::AutoEscaping> into the constructor. + +Unfortunately that is not possible when you configure L<Template>::Toolkit from +your Dancer2 configuration file. You cannot instantiate a Perl object in a yaml file. +Instead, you need to subclass this module, and use the subclass in your configuration file. + +A subclass to use the aforementioned L<Template::Stash::AutoEscaping> might look like this: + + package Dancer2::Template::TemplateToolkit::AutoEscaping; + # or MyApp:: + + use Moo; + use Template::Stash::AutoEscaping; + + extends 'Dancer2::Template::TemplateToolkit'; + + around '_build_engine' => sub { + my $orig = shift; + my $self = shift; + + my $tt = $self->$orig(@_); + + # replace the stash object + $tt->service->context->{STASH} = Template::Stash::AutoEscaping->new( + $self->config->{STASH} + ); + + return $tt; + }; + + 1; + +You can then use this new subclass in your config file instead of C<template_toolkit>. + + # in config.yml + engines: + template: + TemplateToolkit::AutoEscaping: + start_tag: '<%' + end_tag: '%>' + # optional arguments here + STASH: + +The same approach should work for SERVICE (L<Template::Service>), CONTEXT (L<Template::Context>), +PARSER (L<Template::Parser>) and GRAMMAR (L<Template::Grammar>). If you intend to replace +several of these components in your app, it is suggested to create an app-specific subclass +that handles all of them at the same time. + +=head2 Template Caching + +L<Template>::Tookit templates can be cached by adding the C<COMPILE_EXT> property to your +template configuration settings: + + # in config.yml + engines: + template: + template_toolkit: + start_tag: '<%' + end_tag: '%>' + COMPILE_EXT: '.tcc' # cached file extension + +Template caching will avoid the need to re-parse template files or blocks each time they are +used. Cached templates are automatically updated when you update the original template file. + +By default, cached templates are saved in the same directory as your template. To save +cached templates in a different directory, you can set the C<COMPILE_DIR> property in your +Dancer2 configuration file. + +Please see L<Template::Manual::Config/Caching_and_Compiling_Options> for further +details and more caching options. + +=head1 SEE ALSO + +L<Dancer2>, L<Dancer2::Core::Role::Template>, L<Template::Toolkit>. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Template/Tiny.pm b/lib/Dancer2/Template/Tiny.pm new file mode 100644 index 00000000..5062e3a5 --- /dev/null +++ b/lib/Dancer2/Template/Tiny.pm @@ -0,0 +1,119 @@ +package Dancer2::Template::Tiny; +# ABSTRACT: Template::Tiny engine for Dancer2 +$Dancer2::Template::Tiny::VERSION = '0.300000'; +use Moo; +use Carp qw/croak/; +use Dancer2::Core::Types; +use Dancer2::Template::Implementation::ForkedTiny; +use Dancer2::FileUtils 'read_file_content'; + +with 'Dancer2::Core::Role::Template'; + +has '+engine' => ( + isa => InstanceOf ['Dancer2::Template::Implementation::ForkedTiny'] +); + +sub _build_engine { + Dancer2::Template::Implementation::ForkedTiny->new( %{ $_[0]->config } ); +} + +sub render { + my ( $self, $template, $tokens ) = @_; + + ( ref $template || -f $template ) + or croak "$template is not a regular file or reference"; + + my $template_data = + ref $template + ? ${$template} + : read_file_content($template); + + my $content; + + $self->engine->process( \$template_data, $tokens, \$content, ) + or die "Could not process template file '$template'"; + + return $content; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Template::Tiny - Template::Tiny engine for Dancer2 + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + +This template engine allows you to use L<Template::Tiny> in L<Dancer2>. + +L<Template::Tiny> is an implementation of a subset of L<Template::Toolkit> (the +major parts) which takes much less memory and is faster. If you're only using +the main functions of Template::Toolkit, you could use Template::Tiny. You can +also seamlessly move back to Template::Toolkit whenever you want. + +However, Dancer2 uses a modified version of L<Template::Tiny>, which is L<Dancer2::Template::Implementation::ForkedTiny>. It adds 2 features : + +=over + +=item * + +opening and closing tag are now configurable + +=item * + +CodeRefs are evaluated and their results is inserted in the result. + +=back + +You can read more on L<Dancer2::Template::Implementation::ForkedTiny>. + +To use this engine, all you need to configure in your L<Dancer2>'s +C<config.yaml>: + + template: "tiny" + +Of course, you can also set this B<while> working using C<set>: + + # code code code + set template => 'tiny'; + +Since L<Dancer2> has internal support for a wrapper-like option with the +C<layout> configuration option, you can have a L<Template::Toolkit>-like WRAPPER +even though L<Template::Tiny> doesn't really support it. + +=head1 METHODS + +=head2 render($template, \%tokens) + +Renders the template. The first arg is a filename for the template file +or a reference to a string that contains the template. The second arg +is a hashref for the tokens that you wish to pass to +L<Template::Toolkit> for rendering. + +=head1 SEE ALSO + +L<Dancer2>, L<Dancer2::Core::Role::Template>, L<Template::Tiny>, +L<Dancer2::Template::Implementation::ForkedTiny>. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Test.pm b/lib/Dancer2/Test.pm new file mode 100644 index 00000000..dfbb5002 --- /dev/null +++ b/lib/Dancer2/Test.pm @@ -0,0 +1,978 @@ +package Dancer2::Test; +# ABSTRACT: Useful routines for testing Dancer2 apps +$Dancer2::Test::VERSION = '0.300000'; +use strict; +use warnings; + +use Carp qw<carp croak>; +use Test::More; +use Test::Builder; +use URI::Escape; +use Data::Dumper; +use File::Temp; +use Ref::Util qw<is_arrayref>; + +use parent 'Exporter'; +our @EXPORT = qw( + dancer_response + + response_content_is + response_content_isnt + response_content_is_deeply + response_content_like + response_content_unlike + + response_status_is + response_status_isnt + + response_headers_include + response_headers_are_deeply + + response_is_file + + route_exists + route_doesnt_exist + + is_pod_covered + route_pod_coverage + +); + +#dancer1 also has read_logs, response_redirect_location_is +#cf. https://github.com/PerlDancer2/Dancer22/issues/25 + +use Dancer2::Core::Dispatcher; +use Dancer2::Core::Request; + +# singleton to store all the apps +my $_dispatcher = Dancer2::Core::Dispatcher->new; + +# prevent deprecation warnings +our $NO_WARN = 0; + +# can be called with the ($method, $path, $option) triplet, +# or can be fed a request object directly, or can be fed +# a single string, assumed to be [ GET => $string ] +# or can be fed a response (which is passed through without +# any modification) +sub dancer_response { + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + + _find_dancer_apps_for_dispatcher(); + + # useful for the high-level tests + return $_[0] if ref $_[0] eq 'Dancer2::Core::Response'; + + my ( $request, $env ) = + ref $_[0] eq 'Dancer2::Core::Request' + ? _build_env_from_request(@_) + : _build_request_from_env(@_); + + # override the set_request so it actually sets our request instead + { + ## no critic qw(TestingAndDebugging::ProhibitNoWarnings) + no warnings qw<redefine once>; + *Dancer2::Core::App::set_request = sub { + my $self = shift; + $self->_set_request( $request ); + $_->set_request( $request ) for @{ $self->defined_engines }; + }; + } + + # since the response is a PSGI response + # we create a Response object which was originally expected + my $psgi_response = $_dispatcher->dispatch($env); + return Dancer2::Core::Response->new( + status => $psgi_response->[0], + headers => $psgi_response->[1], + content => $psgi_response->[2][0], + ); +} + + + +sub _build_request_from_env { + + # arguments can be passed as the triplet + # or as a arrayref, or as a simple string + my ( $method, $path, $options ) = + @_ > 1 ? @_ + : is_arrayref($_[0]) ? @{ $_[0] } + : ( GET => $_[0], {} ); + + my $env = { + %ENV, + REQUEST_METHOD => uc($method), + PATH_INFO => $path, + QUERY_STRING => '', + 'psgi.url_scheme' => 'http', + SERVER_PROTOCOL => 'HTTP/1.0', + SERVER_NAME => 'localhost', + SERVER_PORT => 3000, + HTTP_HOST => 'localhost', + HTTP_USER_AGENT => "Dancer2::Test simulator v " . Dancer2->VERSION, + }; + + if ( defined $options->{params} ) { + my @params; + while ( my ( $p, $value ) = each %{ $options->{params} } ) { + if ( is_arrayref($value) ) { + for my $v (@$value) { + push @params, + uri_escape_utf8($p) . '=' . uri_escape_utf8($v); + } + } + else { + push @params, + uri_escape_utf8($p) . '=' . uri_escape_utf8($value); + } + } + $env->{QUERY_STRING} = join( '&', @params ); + } + + my $request = Dancer2::Core::Request->new( env => $env ); + + # body + $request->body( $options->{body} ) if exists $options->{body}; + + # headers + if ( $options->{headers} ) { + for my $header ( @{ $options->{headers} } ) { + my ( $name, $value ) = @{$header}; + $request->header( $name => $value ); + if ( $name =~ /^cookie$/i ) { + $env->{HTTP_COOKIE} = $value; + } + } + } + + # files + if ( $options->{files} ) { + for my $file ( @{ $options->{files} } ) { + my $headers = $file->{headers}; + $headers->{'Content-Type'} ||= 'text/plain'; + + my $temp = File::Temp->new(); + if ( $file->{data} ) { + print $temp $file->{data}; + close($temp); + } + else { + require File::Copy; + File::Copy::copy( $file->{filename}, $temp ); + } + + my $upload = Dancer2::Core::Request::Upload->new( + filename => $file->{filename}, + size => -s $temp->filename, + tempname => $temp->filename, + headers => $headers, + ); + + ## keep temp_fh in scope so it doesn't get deleted too early + ## But will get deleted by the time the test is finished. + $upload->{temp_fh} = $temp; + + $request->uploads->{ $file->{name} } = $upload; + } + } + + # content-type + if ( $options->{content_type} ) { + $request->content_type( $options->{content_type} ); + } + + return ( $request, $env ); +} + +sub _build_env_from_request { + my ($request) = @_; + + my $env = { + REQUEST_METHOD => $request->method, + PATH_INFO => $request->path, + QUERY_STRING => '', + 'psgi.url_scheme' => 'http', + SERVER_PROTOCOL => 'HTTP/1.0', + SERVER_NAME => 'localhost', + SERVER_PORT => 3000, + HTTP_HOST => 'localhost', + HTTP_USER_AGENT => "Dancer2::Test simulator v" . Dancer2->VERSION, + }; + + # TODO + if ( my $params = $request->{_query_params} ) { + my @params; + while ( my ( $p, $value ) = each %{$params} ) { + if ( is_arrayref($value) ) { + for my $v (@$value) { + push @params, + uri_escape_utf8($p) . '=' . uri_escape_utf8($v); + } + } + else { + push @params, + uri_escape_utf8($p) . '=' . uri_escape_utf8($value); + } + } + $env->{QUERY_STRING} = join( '&', @params ); + } + + # TODO files + + return ( $request, $env ); +} + +sub response_status_is { + my ( $req, $status, $test_name ) = @_; + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + + $test_name ||= "response status is $status for " . _req_label($req); + + my $response = dancer_response($req); + + my $tb = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + $tb->is_eq( $response->[0], $status, $test_name ); +} + +sub _find_route_match { + my ( $request, $env ) = + ref $_[0] eq 'Dancer2::Core::Request' + ? _build_env_from_request(@_) + : _build_request_from_env(@_); + + for my $app (@{$_dispatcher->apps}) { + for my $route (@{$app->routes->{lc($request->method)}}) { + if ( $route->match($request) ) { + return 1; + } + } + } + return 0; +} + +sub route_exists { + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + + my $tb = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + $tb->ok( _find_route_match($_[0]), $_[1]); +} + +sub route_doesnt_exist { + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + + my $tb = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + $tb->ok( !_find_route_match($_[0]), $_[1]); +} + +sub response_status_isnt { + my ( $req, $status, $test_name ) = @_; + + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + + $test_name ||= "response status is not $status for " . _req_label($req); + + my $response = dancer_response($req); + + my $tb = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + $tb->isnt_eq( $response->[0], $status, $test_name ); +} + +{ + # Map comparison operator names to human-friendly ones + my %cmp_name = ( + is_eq => "is", + isnt_eq => "is not", + like => "matches", + unlike => "doesn't match", + ); + + sub _cmp_response_content { + my ( $req, $want, $test_name, $cmp ) = @_; + + if ( @_ == 3 ) { + $cmp = $test_name; + $test_name = $cmp_name{$cmp}; + $test_name = + "response content $test_name $want for " . _req_label($req); + } + + my $response = dancer_response($req); + + my $tb = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + $tb->$cmp( $response->[2][0], $want, $test_name ); + } +} + +sub response_content_is { + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + local $Test::Builder::Level = $Test::Builder::Level + 1; + _cmp_response_content( @_, 'is_eq' ); +} + +sub response_content_isnt { + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + local $Test::Builder::Level = $Test::Builder::Level + 1; + _cmp_response_content( @_, 'isnt_eq' ); +} + +sub response_content_like { + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + local $Test::Builder::Level = $Test::Builder::Level + 1; + _cmp_response_content( @_, 'like' ); +} + +sub response_content_unlike { + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + local $Test::Builder::Level = $Test::Builder::Level + 1; + _cmp_response_content( @_, 'unlike' ); +} + +sub response_content_is_deeply { + my ( $req, $matcher, $test_name ) = @_; + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + $test_name ||= "response content looks good for " . _req_label($req); + + local $Test::Builder::Level = $Test::Builder::Level + 1; + my $response = _req_to_response($req); + is_deeply $response->[2][0], $matcher, $test_name; +} + +sub response_is_file { + my ( $req, $test_name ) = @_; + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + $test_name ||= "a file is returned for " . _req_label($req); + + my $response = _get_file_response($req); + my $tb = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + return $tb->ok( defined($response), $test_name ); +} + +sub response_headers_are_deeply { + my ( $req, $expected, $test_name ) = @_; + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + $test_name ||= "headers are as expected for " . _req_label($req); + + local $Test::Builder::Level = $Test::Builder::Level + 1; + my $response = dancer_response( _expand_req($req) ); + + is_deeply( + _sort_headers( $response->[1] ), + _sort_headers($expected), $test_name + ); +} + +sub response_headers_include { + my ( $req, $expected, $test_name ) = @_; + carp 'Dancer2::Test is deprecated, please use Plack::Test instead' + unless $NO_WARN; + $test_name ||= "headers include expected data for " . _req_label($req); + my $tb = Test::Builder->new; + + my $response = dancer_response($req); + local $Test::Builder::Level = $Test::Builder::Level + 1; + + print STDERR "Headers are: " + . Dumper( $response->[1] ) + . "\n Expected to find header: " + . Dumper($expected) + if !$tb->ok( + _include_in_headers( $response->[1], $expected ), + $test_name + ); +} + +sub route_pod_coverage { + + require Pod::Simple::Search; + require Pod::Simple::SimpleTree; + + my $all_routes = {}; + + foreach my $app ( @{ $_dispatcher->apps } ) { + my $routes = $app->routes; + my $available_routes = []; + foreach my $method ( sort { $b cmp $a } keys %$routes ) { + foreach my $r ( @{ $routes->{$method} } ) { + + # we don't need pod coverage for head + next if $method eq 'head'; + push @$available_routes, $method . ' ' . $r->spec_route; + } + } + ## copy dereferenced array + $all_routes->{ $app->name }{routes} = [@$available_routes] + if @$available_routes; + + # Pod::Simple v3.30 excluded the current directory even when in @INC. + # include the current directory as a search path; its backwards compatible + # with previous version. + my $undocumented_routes = []; + my $file = Pod::Simple::Search->new->find( $app->name, '.' ); + if ($file) { + $all_routes->{ $app->name }{has_pod} = 1; + my $parser = Pod::Simple::SimpleTree->new->parse_file($file); + my $pod_dataref = $parser->root; + my $found_routes = {}; + for ( my $i = 0; $i < @$available_routes; $i++ ) { + + my $r = $available_routes->[$i]; + my $app_string = lc $r; + $app_string =~ s/\*/_REPLACED_STAR_/g; + + for ( my $idx = 0; $idx < @$pod_dataref; $idx++ ) { + my $pod_part = $pod_dataref->[$idx]; + + next if !is_arrayref($pod_part); + foreach my $ref_part (@$pod_part) { + is_arrayref($ref_part) + and push @$pod_dataref, $ref_part; + } + + my $pod_string = lc $pod_part->[2]; + $pod_string =~ s/['|"|\s]+/ /g; + $pod_string =~ s/\s$//g; + $pod_string =~ s/\*/_REPLACED_STAR_/g; + if ( $pod_string =~ m/^$app_string$/ ) { + $found_routes->{$app_string} = 1; + next; + } + } + if ( !$found_routes->{$app_string} ) { + push @$undocumented_routes, $r; + } + } + } + else { ### no POD found + $all_routes->{ $app->name }{has_pod} = 0; + } + if (@$undocumented_routes) { + $all_routes->{ $app->name }{undocumented_routes} = + $undocumented_routes; + } + elsif ( !$all_routes->{ $app->name }{has_pod} + && @{ $all_routes->{ $app->name }{routes} } ) + { + ## copy dereferenced array + $all_routes->{ $app->name }{undocumented_routes} = + [ @{ $all_routes->{ $app->name }{routes} } ]; + } + } + + return $all_routes; +} + +sub is_pod_covered { + my ($test_name) = @_; + + $test_name ||= "is pod covered"; + my $route_pod_coverage = route_pod_coverage(); + + my $tb = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + + foreach my $app ( @{ $_dispatcher->apps } ) { + my %undocumented_route = + ( map { $_ => 1 } + @{ $route_pod_coverage->{ $app->name }{undocumented_routes} } ); + $tb->subtest( + $app->name . $test_name, + sub { + foreach my $route ( + @{ $route_pod_coverage->{ $app->name }{routes} } ) + { + ok( !$undocumented_route{$route}, "$route is documented" ); + } + } + ); + } +} + +sub import { + my ( $class, %options ) = @_; + + my @applications; + if ( ref $options{apps} eq ref( [] ) ) { + @applications = @{ $options{apps} }; + } + else { + my ( $caller, $script ) = caller; + + # if no app is passed, assume the caller is one. + @applications = ($caller) if $caller->can('dancer_app'); + } + + # register the apps to the test dispatcher + $_dispatcher->apps( [ map { + $_->dancer_app->finish(); + $_->dancer_app; + } @applications ] ); + + $class->export_to_level( 1, $class, @EXPORT ); +} + +# private + +sub _req_label { + my $req = shift; + + return + ref $req eq 'Dancer2::Core::Response' ? 'response object' + : ref $req eq 'Dancer2::Core::Request' + ? join( ' ', map { $req->$_ } qw/ method path / ) + : is_arrayref($req) ? join( ' ', @$req ) + : "GET $req"; +} + +sub _expand_req { + my $req = shift; + return is_arrayref($req) ? @$req : ( 'GET', $req ); +} + +# Sort arrayref of headers (turn it into a list of arrayrefs, sort by the header +# & value, then turn it back into an arrayref) +sub _sort_headers { + my @originalheaders = @{ shift() }; # take a copy we can modify + my @headerpairs; + while ( my ( $header, $value ) = splice @originalheaders, 0, 2 ) { + push @headerpairs, [ $header, $value ]; + } + + # We have an array of arrayrefs holding header => value pairs; sort them by + # header then value, and return them flattened back into an arrayref + return [ + map {@$_} + sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @headerpairs + ]; +} + +# make sure the given header sublist is included in the full headers array +sub _include_in_headers { + my ( $full_headers, $expected_subset ) = @_; + + # walk through all the expected header pairs, make sure + # they exist with the same value in the full_headers list + # return false as soon as one is not. + for ( my $i = 0; $i < scalar(@$expected_subset); $i += 2 ) { + my ( $name, $value ) = + ( $expected_subset->[$i], $expected_subset->[ $i + 1 ] ); + return 0 + unless _check_header( $full_headers, $name, $value ); + } + + # we've found all the expected pairs in the $full_headers list + return 1; +} + +sub _check_header { + my ( $headers, $key, $value ) = @_; + for ( my $i = 0; $i < scalar(@$headers); $i += 2 ) { + my ( $name, $val ) = ( $headers->[$i], $headers->[ $i + 1 ] ); + return 1 if $name eq $key && $value eq $val; + } + return 0; +} + +sub _req_to_response { + my $req = shift; + + # already a response object + return $req if ref $req eq 'Dancer2::Core::Response'; + + return dancer_response( is_arrayref($req) ? @$req : ( 'GET', $req ) ); +} + +# make sure we have at least one app in the dispatcher, and if not, +# we must have at this point an app within the caller +sub _find_dancer_apps_for_dispatcher { + return if scalar( @{ $_dispatcher->apps } ); + + for ( my $deep = 0; $deep < 5; $deep++ ) { + my $caller = caller($deep); + next if !$caller || !$caller->can('dancer_app'); + + return $_dispatcher->apps( [ $caller->dancer_app ] ); + } + + croak "Unable to find a Dancer2 app, did you use Dancer2 in your test?"; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Test - Useful routines for testing Dancer2 apps + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + + use Test::More; + use Plack::Test; + use HTTP::Request::Common; # install separately + + use YourDancerApp; + + my $app = YourDancerApp->to_app; + my $test = Plack::Test->create($app); + + my $res = $test->request( GET '/' ); + is( $res->code, 200, '[GET /] Request successful' ); + like( $res->content, qr/hello, world/, '[GET /] Correct content' ); + + done_testing; + +=head1 DESCRIPTION + +B<DEPRECATED. This module and all the functions listed below are deprecated. Do +not use this module.> The routines provided by this module for testing Dancer2 +apps are buggy and unnecessary. Instead, use the L<Plack::Test> module as shown +in the SYNOPSIS above and ignore the functions in this documentation. Consult +the L<Plack::Test> documentation for further details. + +This module will be removed from the Dancer2 distribution in the near future. +You should migrate all tests that use it over to the L<Plack::Test> module and +remove this module from your system. This module will throw warnings to remind +you. + +For now, you can silence the warnings by setting the C<NO_WARN> option: + + $Dancer::Test::NO_WARN = 1; + +In the functions below, $test_name is always optional. + +=head1 FUNCTIONS + +=head2 dancer_response ($method, $path, $params, $arg_env); + +Returns a Dancer2::Core::Response object for the given request. + +Only $method and $path are required. + +$params is a hashref with 'body' as a string; 'headers' can be an arrayref or +a HTTP::Headers object, 'files' can be arrayref of hashref, containing some +files to upload: + + dancer_response($method, $path, + { + params => $params, + body => $body, + headers => $headers, + files => [ { filename => '/path/to/file', name => 'my_file' } ], + } + ); + +A good reason to use this function is for testing POST requests. Since POST +requests may not be idempotent, it is necessary to capture the content and +status in one shot. Calling the response_status_is and response_content_is +functions in succession would make two requests, each of which could alter the +state of the application and cause Schrodinger's cat to die. + + my $response = dancer_response POST => '/widgets'; + is $response->status, 202, "response for POST /widgets is 202"; + is $response->content, "Widget #1 has been scheduled for creation", + "response content looks good for first POST /widgets"; + + $response = dancer_response POST => '/widgets'; + is $response->status, 202, "response for POST /widgets is 202"; + is $response->content, "Widget #2 has been scheduled for creation", + "response content looks good for second POST /widgets"; + +It's possible to test file uploads: + + post '/upload' => sub { return upload('image')->content }; + + $response = dancer_response(POST => '/upload', {files => [{name => 'image', filename => '/path/to/image.jpg'}]}); + +In addition, you can supply the file contents as the C<data> key: + + my $data = 'A test string that will pretend to be file contents.'; + $response = dancer_response(POST => '/upload', { + files => [{name => 'test', filename => "filename.ext", data => $data}] + }); + +You can also supply a hashref of headers: + + headers => { 'Content-Type' => 'text/plain' } + +=head2 response_status_is ($request, $expected, $test_name); + +Asserts that Dancer2's response for the given request has a status equal to the +one given. + + response_status_is [GET => '/'], 200, "response for GET / is 200"; + +=head2 route_exists([$method, $path], $test_name) + +Asserts that the given request matches a route handler in Dancer2's +registry. If the route would have returned a 404, the route still exists +and this test will pass. + +Note that because Dancer2 uses the default route handler +L<Dancer2::Handler::File> to match files in the public folder when +no other route matches, this test will always pass. +You can disable the default route handlers in the configs but you probably +want L<Dancer2::Test/response_status_is> or L<Dancer2::Test/dancer_response> + + route_exists [GET => '/'], "GET / is handled"; + +=head2 route_doesnt_exist([$method, $path], $test_name) + +Asserts that the given request does not match any route handler +in Dancer2's registry. + +Note that this test is likely to always fail as any route not matched will +be handled by the default route handler in L<Dancer2::Handler::File>. +This can be disabled in the configs. + + route_doesnt_exist [GET => '/bogus_path'], "GET /bogus_path is not handled"; + +=head2 response_status_isnt([$method, $path], $status, $test_name) + +Asserts that the status of Dancer2's response is not equal to the +one given. + + response_status_isnt [GET => '/'], 404, "response for GET / is not a 404"; + +=head2 response_content_is([$method, $path], $expected, $test_name) + +Asserts that the response content is equal to the C<$expected> string. + + response_content_is [GET => '/'], "Hello, World", + "got expected response content for GET /"; + +=head2 response_content_isnt([$method, $path], $not_expected, $test_name) + +Asserts that the response content is not equal to the C<$not_expected> string. + + response_content_isnt [GET => '/'], "Hello, World", + "got expected response content for GET /"; + +=head2 response_content_like([$method, $path], $regexp, $test_name) + +Asserts that the response content for the given request matches the regexp +given. + + response_content_like [GET => '/'], qr/Hello, World/, + "response content looks good for GET /"; + +=head2 response_content_unlike([$method, $path], $regexp, $test_name) + +Asserts that the response content for the given request does not match the regexp +given. + + response_content_unlike [GET => '/'], qr/Page not found/, + "response content looks good for GET /"; + +=head2 response_content_is_deeply([$method, $path], $expected_struct, $test_name) + +Similar to response_content_is(), except that if response content and +$expected_struct are references, it does a deep comparison walking each data +structure to see if they are equivalent. + +If the two structures are different, it will display the place where they start +differing. + + response_content_is_deeply [GET => '/complex_struct'], + { foo => 42, bar => 24}, + "got expected response structure for GET /complex_struct"; + +=head2 response_is_file ($request, $test_name); + +=head2 response_headers_are_deeply([$method, $path], $expected, $test_name) + +Asserts that the response headers data structure equals the one given. + + response_headers_are_deeply [GET => '/'], [ 'X-Powered-By' => 'Dancer2 1.150' ]; + +=head2 response_headers_include([$method, $path], $expected, $test_name) + +Asserts that the response headers data structure includes some of the defined ones. + + response_headers_include [GET => '/'], [ 'Content-Type' => 'text/plain' ]; + +=head2 route_pod_coverage() + +Returns a structure describing pod coverage in your apps + +for one app like this: + + package t::lib::TestPod; + use Dancer2; + + =head1 NAME + + TestPod + + =head2 ROUTES + + =over + + =cut + + =item get "/in_testpod" + + testpod + + =cut + + get '/in_testpod' => sub { + return 'get in_testpod'; + }; + + get '/hello' => sub { + return "hello world"; + }; + + =item post '/in_testpod/*' + + post in_testpod + + =cut + + post '/in_testpod/*' => sub { + return 'post in_testpod'; + }; + + =back + + =head2 SPECIALS + + =head3 PUBLIC + + =over + + =item get "/me:id" + + =cut + + get "/me:id" => sub { + return "ME"; + }; + + =back + + =head3 PRIVAT + + =over + + =item post "/me:id" + + post /me:id + + =cut + + post "/me:id" => sub { + return "ME"; + }; + + =back + + =cut + + 1; + +route_pod_coverage; + +would return something like: + + { + 't::lib::TestPod' => { + 'has_pod' => 1, + 'routes' => [ + "post /in_testpod/*", + "post /me:id", + "get /in_testpod", + "get /hello", + "get /me:id" + ], + 'undocumented_routes' => [ + "get /hello" + ] + } + } + +=head2 is_pod_covered('is pod covered') + +Asserts that your apps have pods for all routes + + is_pod_covered 'is pod covered' + +to avoid test failures, you should document all your routes with one of the following: +head1, head2,head3,head4, item. + + ex: + + =item get '/login' + + route to login + + =cut + + if you use: + + any '/myaction' => sub { + # code + } + + or + + any ['get', 'post'] => '/myaction' => sub { + # code + }; + + you need to create pods for each one of the routes created there. + +=head2 import + +When Dancer2::Test is imported, it should be passed all the +applications that are supposed to be tested. + +If none passed, then the caller is supposed to be the sole application +to test. + + # t/sometest.t + + use t::lib::Foo; + use t::lib::Bar; + + use Dancer2::Test apps => ['t::lib::Foo', 't::lib::Bar']; + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Dancer2/Tutorial.pod b/lib/Dancer2/Tutorial.pod new file mode 100644 index 00000000..870fa66d --- /dev/null +++ b/lib/Dancer2/Tutorial.pod @@ -0,0 +1,722 @@ +package Dancer2::Tutorial; +# ABSTRACT: An example to get you dancing + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Dancer2::Tutorial - An example to get you dancing + +=head1 VERSION + +version 0.300000 + +=head1 What is Dancer2? + +Dancer2 is a "micro" web framework which is modeled after a Ruby framework +called L<Sinatra|http://www.sinatrarb.com> that constructs web applications +by building a list of HTTP verbs, URLs (called routes) and methods to handle +that type of traffic to that specific URL. + + use Dancer2; + + get '/' => sub { + return 'Hello World!'; + }; + + start; + +This example shows a single HTTP verb "GET" followed by the root URL "/" and +an anonymous subroutine which returns the string C<"Hello World!"> If you +were to run this example, it would display "Hello World!" when you point +your browser at L<http://localhost:3000>. + +=head1 How about a little more involved example? + +That's the reason I wrote this tutorial. While I was investigating some +Python web frameworks like L<Flask|http://flask.pocoo.org/> or +L<Bottle|https://bottlepy.org/docs/dev/> I enjoyed the way they +explained step by step how to build an example application which was a +little more involved than a trivial example. + +Using the +L<Flaskr|https://github.com/pallets/flask> +sample application as my inspiration (OK, shamelessly plagiarised) I +translated that application to the Dancer2 framework so I could better +understand how Dancer2 worked. (I'm learning it too!) + +So "Dancr" was born. + +Dancr is a simple "micro" blog which uses the +L<SQLite|http://www.sqlite.org> database engine for simplicity's sake. +(You'll need to install sqlite if you don't have it installed already.) + +=head1 Required perl modules + +Obviously you need L<Dancer2>. You also need the L<Template +Toolkit|Template>, L<File::Slurper>, and L<DBD::SQLite>. These all can be +installed using your CPAN client, as in: + + cpan Dancer2 Template File::Slurper DBD::SQLite + +=head1 The database + +We're not going to spend a lot of time on the database, as it's not really +the point of this particular tutorial. Open your favorite L<text +editor|http://www.vim.org> and create a schema definition called +'schema.sql' with the following content: + + create table if not exists entries ( + id integer primary key autoincrement, + title string not null, + text string not null + ); + +Here we have a single table with three columns: id, title, and text. The +'id' field is the primary key and will automatically get an ID assigned by +the database engine when a row is inserted. + +We want our application to initialize the database automatically for us when +we start it, so next, create a file called 'dancr.pl'. (The entire file is +listed below, so don't worry about copying each of these fragments into +'dancr.pl' as you read through this document.) We're going to put the +following subroutines in that file: + + sub connect_db { + my $dbh = DBI->connect("dbi:SQLite:dbname=".setting('database')) or + die $DBI::errstr; + + return $dbh; + } + + sub init_db { + my $db = connect_db(); + my $schema = read_text('./schema.sql'); + $db->do($schema) or die $db->errstr; + } + +Nothing too fancy in here, I hope. Standard DBI except for the +C<setting('database')> thing - more on that in a bit. For now, just assume +that the expression evaluates to the location of the database file. + +(Note that you may want to look at the L<Dancer2::Plugin::Database> module +for an easy way to configure and manage database connections for your +Dancer2 apps, but the above will suffice for this tutorial.) + +=head1 Our first route handler + +Let's tackle our first route handler now, the one for the root URL '/'. This +is what it looks like: + + get '/' => sub { + my $db = connect_db(); + my $sql = 'select id, title, text from entries order by id desc'; + my $sth = $db->prepare($sql) or die $db->errstr; + $sth->execute or die $sth->errstr; + template 'show_entries.tt', { + 'msg' => get_flash(), + 'add_entry_url' => uri_for('/add'), + 'entries' => $sth->fetchall_hashref('id'), + }; + }; + +As you can see, the handler is created by specifying the HTTP verb 'get', +the '/' URL to match, and finally, a subroutine to do something once those +conditions have been satisfied. Something you might not notice right away +is the semicolon at the end of the route handler. Since the subroutine +is actually a coderef, it requires a semicolon. + +Let's take a closer look at the subroutine. The first few lines are +standard DBI. The only new concept as part of Dancer2 is that C<template> +directive at the end of the handler. That tells Dancer2 to process the +output through one of its templating engines. In this case, we're using +L<Template Toolkit|Template> which offers a lot more flexibility than the +simple default Dancer2 template engine. + +Templates all go into the C<views/> directory. Optionally, you can create a +"layout" template which provides a consistent look and feel for all of your +views. We'll construct our own layout template cleverly named F<main.tt> a +little later in this tutorial. + +What's going on with the hashref as the second argument to the template +directive? Those are all of the parameters we want to pass into our +template. We have a C<msg> field which displays a message to the user when +an event happens like a new entry is posted, or the user logs in or out. +It's called a "flash" message because we only want to display it one time, +not every time the / URL is rendered. + +The C<uri_for> directive tells Dancer2 to provide a URI for that specific +route, in this case, it is the route to post a new entry into the database. +You might ask why we don't simply hardcode the C</add> URI in our +application or templates. The best reason B<not> to do that is because it +removes a layer of flexibility as to where to "mount" the web application. +Although the application is coded to use the root URL C</> it might be +better in the future to locate it under its own URL route (maybe C</dancr>?) +- at that point we'd have to go through our application and the templates +and update the URLs and hope we didn't miss any of them. By using the +C<uri_for> Dancer2 method, we can easily load the application wherever we +like and not have to modify the application at all. + +Finally, the C<entries> field contains a hashref with the results from our +database query. Those results will be rendered in the template itself, so +we just pass them in. + +So what does the F<show_entries.tt> template look like? This: + + [% IF session.logged_in %] + <form action="[% add_entry_url %]" method=post class=add-entry> + <dl> + <dt>Title: + <dd><input type=text size=30 name=title> + <dt>Text: + <dd><textarea name=text rows=5 cols=40></textarea> + <dd><input type=submit value=Share> + </dl> + </form> + [% END %] + <ul class=entries> + [% IF entries.size %] + [% FOREACH id IN entries.keys.nsort %] + <li><h2>[% entries.$id.title | html %]</h2>[% entries.$id.text | html %] + [% END %] + [% ELSE %] + <li><em>Unbelievable. No entries here so far</em> + [% END %] + </ul> + +Again, since this isn't a tutorial specifically about Template Toolkit, I'm +going to gloss over the syntax here and just point out the section which +starts with C<E<lt>ul class=entriesE<gt>> - this is the section where the +database query results are displayed. You can also see at the very top some +discussion about a session - more on that soon. + +The only other Template Toolkit related thing that has to be mentioned here is +the C<| html> in C<[% entries.$id.title | html %]>. That's +L<a filter|http://www.template-toolkit.org/docs/manual/Filters.html#section_html> +to convert characters like C<E<lt>> and C<E<gt>> to C<<> and C<>>. This +way they will be displayed by the browser as content on the page rather than +just included. If we did not do this, the browser might interpret content as +part of the page, and a malicious user could smuggle in all kinds of bad code +that would then run in another user's browser. This is called +L<Cross Site Scripting|https://en.wikipedia.org/wiki/Cross-site_scripting> or +XSS and you should make sure to avoid it by always filtering data that came +in from the web when you display it in a template. + +=head1 Other HTTP verbs + +There are 8 defined HTTP verbs defined in L<RFC +2616|http://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9>: OPTIONS, +GET, HEAD, POST, PUT, DELETE, TRACE, CONNECT. Of these, the majority of web +applications focus on the verbs which closely map to the CRUD (Create, +Retrieve, Update, Delete) operations most database-driven applications need +to implement. + +In addition, the C<PATCH> verb was defined in +L<RFC5789|http://tools.ietf.org/html/rfc5789>, and is intended as a "partial +PUT" - sending just the changes required to the entity in question. How +this would be handled is down to your app, it will vary depending on the +type of entity in question and the serialization in use. + +Dancer2 currently supports GET, PUT/PATCH, POST, DELETE, OPTIONS which map +to Retrieve, Update, Create, Delete respectively. Let's take a look now at +the C</add> route handler which handles a POST operation. + + post '/add' => sub { + if ( not session('logged_in') ) { + send_error("Not logged in", 401); + } + + my $db = connect_db(); + my $sql = 'insert into entries (title, text) values (?, ?)'; + my $sth = $db->prepare($sql) or die $db->errstr; + $sth->execute( + body_parameters->get('title'), + body_parameters->get('text') + ) or die $sth->errstr; + + set_flash('New entry posted!'); + redirect '/'; + }; + +As before, the HTTP verb begins the handler, followed by the route, and a +subroutine to do something - in this case, it will insert a new entry into +the database. + +The first check in the subroutine is to make sure the user sending the data +is logged in. If not, the application returns an error and stops +processing. Otherwise, we have standard DBI stuff. Let me insert (heh, heh) +a blatant plug here for always, always using parameterized INSERTs in your +application SQL statements. It's the only way to be sure your application +won't be vulnerable to SQL injection. (See L<http://www.bobby-tables.com> +for correct INSERT examples in multiple languages.) Here we're using the +C<body_parameters> convenience method to pull in the parameters in the current HTTP +request. (You can see the 'title' and 'text' form parameters in the +F<show_entries.tt> template above.) Those values are inserted into the +database, then we set a flash message for the user and redirect her back to +the root URL. + +It's worth mentioning that the "flash message" is not part of Dancer2, but a +part of this specific application. We need to implement it ourself. + + sub set_flash { + my $message = shift; + + session flash => $message; + } + + sub get_flash { + my $msg = session('flash'); + session->delete('flash'); + + return $msg; + } + +We need a way to save our temporary message, and a way to get it back out. +Since it is a temporary message that should only be shown on the page +immediately following the one where the value was set, we need to delete it +once it was read. + +=head1 Sessions and logins + +A good way to implement this "flash message" mechanic is to write the message +to the user's session. The session stores data for a specific user for the +whole time she uses the application. It persists over all requests this user +makes. You can read more about how to use the session +in L<our manual|Dancer2::Manual/"SESSIONS">. + +Dancer2 comes with a simple in-memory session manager out of the box. It +supports a bunch of other session engines including YAML, memcached, browser +cookies and others. For this application we're going to stick with the +in-memory model which works great for development and tutorials, but won't +persist across server restarts or scale very well in "real world" production +scenarios. + +=head2 Configuration options + +To use sessions in our application, we have to tell Dancer2 to activate the +session handler and initialize a session manager. To do that, we add some +configuration directives toward the top of our 'dancr.pl' file. But there are +more options than just the session engine we want to set. + + set 'database' => File::Spec->catfile(File::Spec->tmpdir(), 'dancr.db'); + set 'session' => 'Simple'; + set 'template' => 'template_toolkit'; + set 'logger' => 'console'; + set 'log' => 'debug'; + set 'show_errors' => 1; + set 'startup_info' => 1; + set 'warnings' => 1; + +Hopefully these are fairly self-explanatory. We want the Simple session +engine, the Template Toolkit template engine, logging enabled (at the +'debug' level with output to the console instead of a file), we want to show +errors to the web browser, log access attempts and log Dancer2 warnings +(instead of silently ignoring them). + +In a more sophisticated application you would want to put these +configuration options into a configuration file, but for this tutorial, +we're going to keep it simple. Dancer2 also supports the notion of +application environments, meaning you can create a configuration file for +your development instance, and another config file for the production +environment (with things like debugging and showing errors disabled +perhaps). Dancer2 also doesn't impose any limits on what parameters you can +set using the C<set> syntax. For this application we're going to embed our +single username and password into the application itself: + + set 'username' => 'admin'; + set 'password' => 'password'; + +Hopefully no one will ever guess our clever password! Obviously, you will +want a more sophisticated user authentication scheme in any sort of +non-tutorial application but this is good enough for our purposes. + +=head2 Logging in + +Now that Dancr is configured to handle sessions, let's take a look at the +URL handler for the C</login> route. + + any ['get', 'post'] => '/login' => sub { + my $err; + + if ( request->method() eq "POST" ) { + # process form input + if ( body_parameters->get('username') ne setting('username') ) { + $err = "Invalid username"; + } + elsif ( body_parameters->get('password') ne setting('password') ) { + $err = "Invalid password"; + } + else { + session 'logged_in' => true; + set_flash('You are logged in.'); + return redirect '/'; + } + } + + # display login form + template 'login.tt', { + 'err' => $err, + }; + }; + +This is the first handler which accepts two different verb types, a GET for +a human browsing to the URL and a POST for the browser to submit the user's +input to the web application. Since we're handling two different verbs, we +check to see what verb is in the request. If it's B<not> a POST, we drop +down to the C<template> directive and display the F<login.tt> template: + + <h2>Login</h2> + [% IF err %]<p class=error><strong>Error:</strong> [% err %][% END %] + <form action="[% login_url %]" method=post> + <dl> + <dt>Username: + <dd><input type=text name=username> + <dt>Password: + <dd><input type=password name=password> + <dd><input type=submit value=Login> + </dl> + </form> + +This is even simpler than our F<show_entries.tt> template - but wait - +there's a C<login_url> template parameter and we're only passing in the +C<err> parameter. Where's the missing parameter? It's being generated and +sent to the template in a C<before_template_render> directive - we'll come +back to that in a moment or two. + +So the user fills out the F<login.tt> template and submits it back to the +C</login> route handler. We now check the user input against our +application settings and if the input is incorrect, we alert the user, otherwise +the application starts a session and sets the C<logged_in> session parameter +to the C<true()> value. Dancer2 exports both a C<true()> and C<false()> +convenience method which we use here. After that, it's another flash +message and back to the root URL handler. + +=head2 Logging out + +And finally, we need a way to clear our user's session with the customary +logout procedure. + + get '/logout' => sub { + app->destroy_session; + set_flash('You are logged out.'); + redirect '/'; + }; + +C<app-E<gt>destroy_session;> is Dancer2's way to remove a stored session. +We notify the user she is logged out and route her back to the root URL once +again. + +You might wonder how we can then set a value in the session in C<set_flash>, +because we just destroyed the session. + +Destroying the session has removed the data from the persistence layer (which +is the memory of our running application, because we are using the C<simple> +session engine). If we write to I<the session> now, it will actually create +a completely new session for our user. This new, empty session will have a new +I<session ID>, which Dancer2 tells the user's browser about in the response. +When the browser requests the root URL, it will send this new session ID to our +application. + +=head1 Layout and static files + +We still have a missing puzzle piece or two. First, how can we use Dancer2 +to serve our CSS stylesheet? Second, where are flash messages displayed? +Third, what about the C<before_template_render> directive? + +=head2 Serving static files + +In Dancer2, static files should go into the C<public/> directory, but in the +application itself be sure to omit the C<public/> element from the path. For +example, the stylesheet for Dancr lives in C<dancr/public/css/style.css> but +is served from L<http://localhost:3000/css/style.css>. + +If you wanted to build a mostly static web site you could simply write route +handlers like this one: + + get '/' => sub { + send_file 'index.html'; + }; + +where index.html would live in your C<public/> directory. + +C<send_file> does exactly what it says: it loads a static file, then sends +the contents of that file to the user. + +=head2 Layouts + +I mentioned near the beginning of this tutorial that it is possible to +create a C<layout> template. In Dancr, that layout is called C<main> and +it's set up by putting in a directive like this: + + set layout => 'main'; + +near the top of your web application. This tells Dancer2's template +engine that it should look for a file called F<main.tt> in +C<dancr/views/layouts/> and insert the calls from the C<template> directive +into a template parameter called C<content>. + +For this web application, the layout template looks like this: + + <!doctype html> + <html> + <head> + <title>Dancr</title> + <link rel=stylesheet type=text/css href="[% css_url %]"> + </head> + <body> + <div class=page> + <h1>Dancr</h1> + <div class=metanav> + [% IF not session.logged_in %] + <a href="[% login_url %]">log in</a> + [% ELSE %] + <a href="[% logout_url %]">log out</a> + [% END %] + </div> + [% IF msg %] + <div class=flash> [% msg %] </div> + [% END %] + [% content %] + </div> + </body> + </html> + +Aha! You now see where the flash message C<msg> parameter gets rendered. You +can also see where the content from the specific route handlers is inserted +(the fourth line from the bottom in the C<content> template parameter). + +But what about all those other C<*_url> template parameters? + +=head2 Using C<before_template_render> + +Dancer2 has a way to manipulate the template parameters before they're +passed to the engine for processing. It's C<before_template_render>. Using +this directive, you can generate and set the URIs for the C</login> and +C</logout> route handlers and the URI for the stylesheet. This is handy for +situations like this where there are values which are re-used consistently +across all (or most) templates. This cuts down on code-duplication and +makes your app easier to maintain over time since you only need to update +the values in this one place instead of everywhere you render a template. + + hook before_template_render => sub { + my $tokens = shift; + + $tokens->{'css_url'} = request->base . 'css/style.css'; + $tokens->{'login_url'} = uri_for('/login'); + $tokens->{'logout_url'} = uri_for('/logout'); + }; + +Here again I'm using C<uri_for> instead of hardcoding the routes. This code +block is executed before any of the templates are processed so that the +template parameters have the appropriate values before being rendered. + +=head1 Putting it all together + +Here's the complete 'dancr.pl' script from start to finish. + + use Dancer2; + use DBI; + use File::Spec; + use File::Slurper qw/ read_text /; + use Template; + + set 'database' => File::Spec->catfile(File::Spec->tmpdir(), 'dancr.db'); + set 'session' => 'Simple'; + set 'template' => 'template_toolkit'; + set 'logger' => 'console'; + set 'log' => 'debug'; + set 'show_errors' => 1; + set 'startup_info' => 1; + set 'warnings' => 1; + set 'username' => 'admin'; + set 'password' => 'password'; + set 'layout' => 'main'; + + sub set_flash { + my $message = shift; + + session flash => $message; + } + + sub get_flash { + my $msg = session('flash'); + session->delete('flash'); + + return $msg; + } + + sub connect_db { + my $dbh = DBI->connect("dbi:SQLite:dbname=".setting('database')) or + die $DBI::errstr; + + return $dbh; + } + + sub init_db { + my $db = connect_db(); + my $schema = read_text('./schema.sql'); + $db->do($schema) or die $db->errstr; + } + + hook before_template_render => sub { + my $tokens = shift; + + $tokens->{'css_url'} = request->base . 'css/style.css'; + $tokens->{'login_url'} = uri_for('/login'); + $tokens->{'logout_url'} = uri_for('/logout'); + }; + + get '/' => sub { + my $db = connect_db(); + my $sql = 'select id, title, text from entries order by id desc'; + my $sth = $db->prepare($sql) or die $db->errstr; + $sth->execute or die $sth->errstr; + template 'show_entries.tt', { + 'msg' => get_flash(), + 'add_entry_url' => uri_for('/add'), + 'entries' => $sth->fetchall_hashref('id'), + }; + }; + + post '/add' => sub { + if ( not session('logged_in') ) { + send_error("Not logged in", 401); + } + + my $db = connect_db(); + my $sql = 'insert into entries (title, text) values (?, ?)'; + my $sth = $db->prepare($sql) or die $db->errstr; + $sth->execute( + body_parameters->get('title'), + body_parameters->get('text') + ) or die $sth->errstr; + + set_flash('New entry posted!'); + redirect '/'; + }; + + any ['get', 'post'] => '/login' => sub { + my $err; + + if ( request->method() eq "POST" ) { + # process form input + if ( body_parameters->get('username') ne setting('username') ) { + $err = "Invalid username"; + } + elsif ( body_parameters->get('password') ne setting('password') ) { + $err = "Invalid password"; + } + else { + session 'logged_in' => true; + set_flash('You are logged in.'); + return redirect '/'; + } + } + + # display login form + template 'login.tt', { + 'err' => $err, + }; + + }; + + get '/logout' => sub { + app->destroy_session; + set_flash('You are logged out.'); + redirect '/'; + }; + + init_db(); + start; + +=head1 Advanced route moves + +There's a lot more to route matching than shown here. For example, you can +match routes with regular expressions, or you can match pieces of a route +like C</hello/:name> where the C<:name> piece magically turns into a named +parameter in your handler for manipulation. + +=head1 Next Steps + +Hopefully this effort has been helpful and interesting enough to get you +exploring Dancer2 on your own. Dancer2 is suitable for projects of all +shapes and sizes, and you can easily build a solution tailored to your +particular needs. + +There is certainly a lot left to cover. We suggest you take a stroll through +the L<manual|Dancer2::Manual>for more detailed information about the +topics covered in this tutorial, and for a more thorough explanation of all +things Dancer2-related. The L<cookbook|Dancer2::Cookbook> will show you how +to handle some handy tips and tricks when working with Dancer2. Additionally, +there are a lot of great L<plugins|https://metacpan.org/search?q=Dancer2%3A%3APlugin> +which extend and enhance the capabilities of the framework. + +Happy dancing! + +=head1 SEE ALSO + +=over 4 + +=item * + +L<http://perldancer.org> + +=item * + +L<http://github.com/PerlDancer/Dancer2> + +=item * + +L<Dancer2::Plugins> + +=back + +=head1 CSS COPYRIGHT AND LICENSE + +The CSS stylesheet is copied verbatim from the Flaskr example application +and is subject to their license: + +Copyright (c) 2010, 2013 by Armin Ronacher and contributors. + +Some rights reserved. + +Redistribution and use in source and binary forms of the software as well as +documentation, with or without modification, are permitted provided that the +following conditions are met: + +=over 4 + +=item * + +Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. + +=item * + +Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +=item * + +The names of the contributors may not be used to endorse or promote products +derived from this software without specific prior written permission. + +=back + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/script/dancer2 b/script/dancer2 new file mode 100755 index 00000000..503ea67a --- /dev/null +++ b/script/dancer2 @@ -0,0 +1,208 @@ +#!/usr/bin/perl +# PODNAME: dancer2 +# ABSTRACT: Dancer2 command line interface + +use strict; +use warnings; +use Dancer2::CLI; + +# backward compatibility +if (@ARGV && ($ARGV[0] =~ m/^-(a|p|x|s)/ || $ARGV[0] =~ m/^--(application|path|no-check|skel)/)) { + # GetOptions and Getopt::Long::Descriptive differently treats + # cases like '-a=Test'. GetOptions returs 'Test' as value of 'a', + # while Getopt::Long::Descriptive returns '=Test' as value + foreach (@ARGV) { + s/^\-(a|p)=/-$1/; + } + + unshift @ARGV, 'gen'; +} + + +exit Dancer2::CLI->run; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +dancer2 - Dancer2 command line interface + +=head1 VERSION + +version 0.300000 + +=head1 SYNOPSIS + +dancer2 <command> [options...] + +=head1 DESCRIPTION + +Dancer2 is the new generation lightweight web-framework for Perl. +This tool provides nice, easily-extendable CLI interface for it. + +=head2 Documentation Index + +Documentation on Dancer2 is split into several manpages. Below is a +complete outline on where to go for help. + +=over 4 + +=item * Dancer2 Tutorial + +If you are new to the Dancer approach, you should start by reading +our L<Dancer2::Tutorial>. + +=item * Dancer2 Manual + +L<Dancer2::Manual> is the reference for Dancer2. Here you will find +information on the concepts of Dancer2 application development and +a comprehensive reference to the Dancer2 domain specific +language. + +=item * Dancer2 Keywords + +The keywords for Dancer2 can be found under L<DSL Keywords|Dancer2::Manual/DSL KEYWORDS>. + +=item * Dancer2 Deployment + +For configuration examples of different deployment solutions involving +Dancer2 and Plack, refer to L<Dancer2::Manual::Deployment>. + +=item * Dancer2 Cookbook + +Specific examples of code for real-life problems and some 'tricks' for +applications in Dancer can be found in L<Dancer2::Cookbook> + +=item * Dancer2 Config + +For configuration file details refer to L<Dancer2::Config>. It is a +complete list of all configuration options. + +=item * Dancer2 Plugins + +Refer to L<Dancer2::Plugins> for a partial list of available Dancer2 +plugins. Note that although we try to keep this list up to date we +expect plugin authors to tell us about new modules. + +=item * Dancer2 Migration guide + +L<Dancer2::Manual::Migration> provides the most up-to-date instruction on +how to convert a Dancer (1) based application to Dancer2. + +=back + +=head1 NAME + +dancer2 - Dancer2 command line interface + +=head1 COMMANDS + +=over + +=item gen : create new Dancer2 application + +=item commands : list the application's commands + +=item help : display a command's help screen + +=item version : display version + +=back + +To get detailed description of each individual command run: + dancer2 help <command> + +The lastest list of available commands can be dispayed by: + dancer2 commands + +=head1 COMMAND 'gen' + +Helper script for providing a bootstrapping method to quickly and easily create +the framework for a new Dancer2 application. + +=head3 OPTIONS + + -a --application the name of your application + -p --path the path where to create your application + (current directory if not specified) + -o --overwrite overwrite existing files + -x --no-check don't check for the latest version of Dancer2 + (checking version implies internet connection) + -s --skel skeleton directory + +=head3 EXAMPLE + +Here is an application created with dancer2: + + $ dancer2 gen -a MyWeb::App + + MyWeb-App + + MyWeb-App/bin + + MyWeb-App/bin/app.psgi + + MyWeb-App/config.yml + + MyWeb-App/environments + + MyWeb-App/environments/development.yml + + MyWeb-App/environments/production.yml + + MyWeb-App/views + + MyWeb-App/views/index.tt + + MyWeb-App/views/layouts + + MyWeb-App/views/layouts/main.tt + + MyWeb-App/MANIFEST.SKIP + + MyWeb-App/lib + + MyWeb-App/lib/MyWeb + + MyWeb-App/lib/MyWeb/App.pm + + MyWeb-App/public + + MyWeb-App/public/css + + MyWeb-App/public/css/style.css + + MyWeb-App/public/css/error.css + + MyWeb-App/public/images + + MyWeb-App/public/500.html + + MyWeb-App/public/404.html + + MyWeb-App/public/dispatch.fcgi + + MyWeb-App/public/dispatch.cgi + + MyWeb-App/public/javascripts + + MyWeb-App/public/javascripts/jquery.js + + MyWeb-App/t + + MyWeb-App/t/002_index_route.t + + MyWeb-App/t/001_base.t + + MyWeb-App/Makefile.PL + +The application is ready to serve: + + $ cd MyWeb-App + $ plackup bin/app.psgi + >> Listening on 127.0.0.1:3000 + == Entering the development dance floor ... + +=head1 AUTHOR + +This script has been written by Ivan Kruglov +<ivan.kruglov@yahoo.com> base on original dancer2 +script which has been written by Sebastien Deseille +<sebastien.deseille@gmail.com> and Alexis Sukrieh +<sukria@cpan.org>. + +=head1 SOURCE CODE + +See L<Dancer2> for more information. + +=head1 LICENSE + +This module is free software and is published under the same +terms as Perl itself. + +=head1 AUTHOR + +Dancer Core Developers + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2019 by Alexis Sukrieh. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/share/skel/.dancer b/share/skel/.dancer new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/share/skel/.dancer diff --git a/share/skel/MANIFEST.SKIP b/share/skel/MANIFEST.SKIP new file mode 100644 index 00000000..ed99aede --- /dev/null +++ b/share/skel/MANIFEST.SKIP @@ -0,0 +1,16 @@ +^\.git\/ +maint +^tags$ +.last_cover_stats +Makefile$ +^blib +^pm_to_blib +^.*.bak +^.*.old +^t.*sessions +^cover_db +^.*\.log +^.*\.swp$ +MYMETA.* +^.gitignore +^.svn\/ diff --git a/share/skel/Makefile.PL b/share/skel/Makefile.PL new file mode 100644 index 00000000..1012ec73 --- /dev/null +++ b/share/skel/Makefile.PL @@ -0,0 +1,26 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +# Normalize version strings like 6.30_02 to 6.3002, +# so that we can do numerical comparisons on it. +my $eumm_version = $ExtUtils::MakeMaker::VERSION; +$eumm_version =~ s/_//; + +WriteMakefile( + NAME => '[d2% appname %2d]', + AUTHOR => q{YOUR NAME <youremail@example.com>}, + VERSION_FROM => '[d2% appfile %2d]', + ABSTRACT => 'YOUR APPLICATION ABSTRACT', + ($eumm_version >= 6.3001 + ? ('LICENSE'=> 'perl') + : ()), + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'YAML' => 0, + 'Dancer2' => [d2% dancer_version %2d], + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => '[d2% cleanfiles %2d]-*' }, +); diff --git a/share/skel/bin/+app.psgi b/share/skel/bin/+app.psgi new file mode 100644 index 00000000..b9015be9 --- /dev/null +++ b/share/skel/bin/+app.psgi @@ -0,0 +1,45 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use FindBin; +use lib "$FindBin::Bin/../lib"; + + +# use this block if you don't need middleware, and only have a single target Dancer app to run here +use [d2% appname %2d]; + +[d2% appname %2d]->to_app; + +=begin comment +# use this block if you want to include middleware such as Plack::Middleware::Deflater + +use [d2% appname %2d]; +use Plack::Builder; + +builder { + enable 'Deflater'; + [d2% appname %2d]->to_app; +} + +=end comment + +=cut + +=begin comment +# use this block if you want to mount several applications on different path + +use [d2% appname %2d]; +use [d2% appname %2d]_admin; + +use Plack::Builder; + +builder { + mount '/' => [d2% appname %2d]->to_app; + mount '/admin' => [d2% appname %2d]_admin->to_app; +} + +=end comment + +=cut + diff --git a/share/skel/config.yml b/share/skel/config.yml new file mode 100644 index 00000000..7240c8a3 --- /dev/null +++ b/share/skel/config.yml @@ -0,0 +1,62 @@ +# This is the main configuration file of your Dancer2 app +# env-related settings should go to environments/$env.yml +# all the settings in this file will be loaded at Dancer's startup. + +# === Basic configuration === + +# Your application's name +appname: "[d2% appname %2d]" + +# The default layout to use for your application (located in +# views/layouts/main.tt) +layout: "main" + +# when the charset is set to UTF-8 Dancer2 will handle for you +# all the magic of encoding and decoding. You should not care +# about unicode within your app when this setting is set (recommended). +charset: "UTF-8" + +# === Engines === +# +# NOTE: All the engine configurations need to be under a single "engines:" +# key. If you uncomment engine configurations below, make sure to delete +# all "engines:" lines except the first. Otherwise, only the last +# "engines:" block will take effect. + +# template engine +# simple: default and very basic template engine +# template_toolkit: TT + +template: "simple" + +# template: "template_toolkit" +# engines: +# template: +# template_toolkit: +# # Note: start_tag and end_tag are regexes +# start_tag: '<%' +# end_tag: '%>' + +# session engine +# +# Simple: in-memory session store - Dancer2::Session::Simple +# YAML: session stored in YAML files - Dancer2::Session::YAML +# +# Check out metacpan for other session storage options: +# https://metacpan.org/search?q=Dancer2%3A%3ASession&search_type=modules +# +# Default value for 'cookie_name' is 'dancer.session'. If you run multiple +# Dancer apps on the same host then you will need to make sure 'cookie_name' +# is different for each app. +# +#engines: +# session: +# Simple: +# cookie_name: testapp.session +# +#engines: +# session: +# YAML: +# cookie_name: eshop.session +# is_secure: 1 +# is_http_only: 1 diff --git a/share/skel/cpanfile b/share/skel/cpanfile new file mode 100644 index 00000000..231bc585 --- /dev/null +++ b/share/skel/cpanfile @@ -0,0 +1,11 @@ +requires "Dancer2" => "[d2% dancer_version %2d]"; + +recommends "YAML" => "0"; +recommends "URL::Encode::XS" => "0"; +recommends "CGI::Deurl::XS" => "0"; +recommends "HTTP::Parser::XS" => "0"; + +on "test" => sub { + requires "Test::More" => "0"; + requires "HTTP::Request::Common" => "0"; +}; diff --git a/share/skel/environments/development.yml b/share/skel/environments/development.yml new file mode 100644 index 00000000..096e5618 --- /dev/null +++ b/share/skel/environments/development.yml @@ -0,0 +1,23 @@ +# configuration file for development environment + +# the logger engine to use +# console: log messages to STDOUT (your console where you started the +# application server) +# file: log message to a file in log/ +logger: "console" + +# the log level for this environment +# core is the lowest, it shows Dancer2's core log messages as well as yours +# (debug, info, warning and error) +log: "core" + +# should Dancer2 consider warnings as critical errors? +warnings: 1 + +# should Dancer2 show a stacktrace when an 5xx error is caught? +# if set to yes, public/500.html will be ignored and either +# views/500.tt, 'error_template' template, or a default error template will be used. +show_errors: 1 + +# print the banner +startup_info: 1 diff --git a/share/skel/environments/production.yml b/share/skel/environments/production.yml new file mode 100644 index 00000000..41b436fc --- /dev/null +++ b/share/skel/environments/production.yml @@ -0,0 +1,16 @@ +# configuration file for production environment + +# only log warning and error messsages +log: "warning" + +# log message to a file in logs/ +logger: "file" + +# don't consider warnings critical +warnings: 0 + +# hide errors +show_errors: 0 + +# disable server tokens in production environments +no_server_tokens: 1 diff --git a/share/skel/lib/AppFile.pm b/share/skel/lib/AppFile.pm new file mode 100644 index 00000000..87b2ab77 --- /dev/null +++ b/share/skel/lib/AppFile.pm @@ -0,0 +1,10 @@ +package [d2% appname %2d]; +use Dancer2; + +our $VERSION = '0.1'; + +get '/' => sub { + template 'index' => { 'title' => '[d2% appname %2d]' }; +}; + +true; diff --git a/share/skel/public/+dispatch.cgi b/share/skel/public/+dispatch.cgi new file mode 100755 index 00000000..b5c2bd97 --- /dev/null +++ b/share/skel/public/+dispatch.cgi @@ -0,0 +1,16 @@ +[d2% perl_interpreter %2d] +BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';} +use Dancer2; +use FindBin '$RealBin'; +use Plack::Runner; + +# For some reason Apache SetEnv directives don't propagate +# correctly to the dispatchers, so forcing PSGI and env here +# is safer. +set apphandler => 'PSGI'; +set environment => 'production'; + +my $psgi = path($RealBin, '..', 'bin', 'app.psgi'); +die "Unable to read startup script: $psgi" unless -r $psgi; + +Plack::Runner->run($psgi); diff --git a/share/skel/public/+dispatch.fcgi b/share/skel/public/+dispatch.fcgi new file mode 100644 index 00000000..51717e54 --- /dev/null +++ b/share/skel/public/+dispatch.fcgi @@ -0,0 +1,18 @@ +[d2% perl_interpreter %2d] +BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';} +use Dancer2; +use FindBin '$RealBin'; +use Plack::Handler::FCGI; + +# For some reason Apache SetEnv directives don't propagate +# correctly to the dispatchers, so forcing PSGI and env here +# is safer. +set apphandler => 'PSGI'; +set environment => 'production'; + +my $psgi = path($RealBin, '..', 'bin', 'app.psgi'); +my $app = do($psgi); +die "Unable to read startup script: $@" if $@; +my $server = Plack::Handler::FCGI->new(nproc => 5, detach => 1); + +$server->run($app); diff --git a/share/skel/public/404.html b/share/skel/public/404.html new file mode 100644 index 00000000..c2f40326 --- /dev/null +++ b/share/skel/public/404.html @@ -0,0 +1,18 @@ +<!DOCTYPE html> +<html lang="en"> +<head> + <meta charset="utf-8"> + <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes"> + <title>Error 404</title> + <link rel="stylesheet" href="/css/error.css"> +</head> +<body> +<h1>Error 404</h1> +<div id="content"> +<h2>Page Not Found</h2><p>Sorry, this is the void.</p> +</div> +<div id="footer"> +Powered by <a href="http://perldancer.org/">Dancer2</a>. +</div> +</body> +</html> diff --git a/share/skel/public/500.html b/share/skel/public/500.html new file mode 100644 index 00000000..d84ebbc4 --- /dev/null +++ b/share/skel/public/500.html @@ -0,0 +1,18 @@ +<!DOCTYPE html> +<html lang="en"> +<head> + <meta charset="utf-8"> + <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes"> + <title>Error 500</title> + <link rel="stylesheet" href="/css/error.css"> +</head> +<body> +<h1>Error 500</h1> +<div id="content"> +<h2>Internal Server Error</h2><p>Wooops, something went wrong</p> +</div> +<div id="footer"> +Powered by <a href="http://perldancer.org/">Dancer2</a>. +</div> +</body> +</html> diff --git a/share/skel/public/css/error.css b/share/skel/public/css/error.css new file mode 100644 index 00000000..8a5e8317 --- /dev/null +++ b/share/skel/public/css/error.css @@ -0,0 +1,85 @@ +body { + font-family: Lucida,sans-serif; +} + +h1 { + color: #AA0000; + border-bottom: 1px solid #444; +} + +h2 { color: #444; } + +pre { + font-family: "lucida console","monaco","andale mono","bitstream vera sans mono","consolas",monospace; + font-size: 12px; + border-left: 2px solid #777; + padding-left: 1em; +} + +footer { + font-size: 10px; +} + +span.key { + color: #449; + font-weight: bold; + width: 120px; + display: inline; +} + +span.value { + color: #494; +} + +/* these are for the message boxes */ + +pre.content { + background-color: #eee; + color: #000; + padding: 1em; + margin: 0; + border: 1px solid #aaa; + border-top: 0; + margin-bottom: 1em; + overflow-x: auto; +} + +div.title { + font-family: "lucida console","monaco","andale mono","bitstream vera sans mono","consolas",monospace; + font-size: 12px; + background-color: #aaa; + color: #444; + font-weight: bold; + padding: 3px; + padding-left: 10px; +} + +table.context { + border-spacing: 0; +} + +table.context th, table.context td { + padding: 0; +} + +table.context th { + color: #889; + font-weight: normal; + padding-right: 15px; + text-align: right; +} + +.errline { + color: red; +} + +pre.error { + background: #334; + color: #ccd; + padding: 1em; + border-top: 1px solid #000; + border-left: 1px solid #000; + border-right: 1px solid #eee; + border-bottom: 1px solid #eee; +} + diff --git a/share/skel/public/css/style.css b/share/skel/public/css/style.css new file mode 100644 index 00000000..80f94ebe --- /dev/null +++ b/share/skel/public/css/style.css @@ -0,0 +1,189 @@ + +body { +margin: 0; +margin-bottom: 25px; +padding: 0; +background-color: #ddd; +background-image: url("/images/perldancer-bg.jpg"); +background-repeat: no-repeat; +background-position: top left; + +font-family: "Lucida Grande", "Bitstream Vera Sans", "Verdana"; +font-size: 13px; +color: #333; +} + +h1 { +font-size: 28px; +color: #000; +} + +a {color: #03c} +a:hover { +background-color: #03c; +color: white; +text-decoration: none; +} + +#page { +background-color: #ddd; +width: 750px; +margin: auto; +margin-left: auto; +padding-left: 0px; +margin-right: auto; +} + +#content { +background-color: white; +border: 3px solid #aaa; +border-top: none; +padding: 25px; +width: 500px; +} + +#sidebar { +float: right; +width: 175px; +} + +#header, #about, #getting-started { +padding-left: 75px; +padding-right: 30px; +} + + +#header { +background-image: url("/images/perldancer.jpg"); +background-repeat: no-repeat; +background-position: top left; +height: 64px; +} +#header h1, #header h2 {margin: 0} +#header h2 { +color: #888; +font-weight: normal; +font-size: 16px; +} + +#about h3 { +margin: 0; +margin-bottom: 10px; +font-size: 14px; +} + +#about-content { +background-color: #ffd; +border: 1px solid #fc0; +margin-left: -11px; +} +#about-content table { +margin-top: 10px; +margin-bottom: 10px; +font-size: 11px; +border-collapse: collapse; +} +#about-content td { +padding: 10px; +padding-top: 3px; +padding-bottom: 3px; +} +#about-content td.name {color: #555} +#about-content td.value {color: #000} + +#about-content.failure { +background-color: #fcc; +border: 1px solid #f00; +} +#about-content.failure p { +margin: 0; +padding: 10px; +} + +#getting-started { +border-top: 1px solid #ccc; +margin-top: 25px; +padding-top: 15px; +} +#getting-started h1 { +margin: 0; +font-size: 20px; +} +#getting-started h2 { +margin: 0; +font-size: 14px; +font-weight: normal; +color: #333; +margin-bottom: 25px; +} +#getting-started ol { +margin-left: 0; +padding-left: 0; +} +#getting-started li { +font-size: 18px; +color: #888; +margin-bottom: 25px; +} +#getting-started li h2 { +margin: 0; +font-weight: normal; +font-size: 18px; +color: #333; +} +#getting-started li p { +color: #555; +font-size: 13px; +} + +#search { +margin: 0; +padding-top: 10px; +padding-bottom: 10px; +font-size: 11px; +} +#search input { +font-size: 11px; +margin: 2px; +} +#search-text {width: 170px} + +#sidebar ul { +margin-left: 0; +padding-left: 0; +} +#sidebar ul h3 { +margin-top: 25px; +font-size: 16px; +padding-bottom: 10px; +border-bottom: 1px solid #ccc; +} +#sidebar li { +list-style-type: none; +} +#sidebar ul.links li { +margin-bottom: 5px; +} + +h1, h2, h3, h4, h5 { +font-family: sans-serif; +margin: 1.2em 0 0.6em 0; +} + +p { +line-height: 1.5em; +margin: 1.6em 0; +} + +code, .filepath, .app-info { + font-family: 'Andale Mono', Monaco, 'Liberation Mono', 'Bitstream Vera Sans Mono', 'DejaVu Sans Mono', monospace; +} + +#footer { +clear: both; +padding-top: 2em; +text-align: center; +padding-right: 160px; +font-family: sans-serif; +font-size: 10px; +} diff --git a/share/skel/public/favicon.ico b/share/skel/public/favicon.ico Binary files differnew file mode 100644 index 00000000..96c74653 --- /dev/null +++ b/share/skel/public/favicon.ico diff --git a/share/skel/public/images/perldancer-bg.jpg b/share/skel/public/images/perldancer-bg.jpg Binary files differnew file mode 100644 index 00000000..6ee6b773 --- /dev/null +++ b/share/skel/public/images/perldancer-bg.jpg diff --git a/share/skel/public/images/perldancer.jpg b/share/skel/public/images/perldancer.jpg Binary files differnew file mode 100644 index 00000000..3f9e718c --- /dev/null +++ b/share/skel/public/images/perldancer.jpg diff --git a/share/skel/t/001_base.t b/share/skel/t/001_base.t new file mode 100644 index 00000000..c876c6ba --- /dev/null +++ b/share/skel/t/001_base.t @@ -0,0 +1,5 @@ +use strict; +use warnings; + +use Test::More tests => 1; +use_ok '[d2% appname %2d]'; diff --git a/share/skel/t/002_index_route.t b/share/skel/t/002_index_route.t new file mode 100644 index 00000000..16af073d --- /dev/null +++ b/share/skel/t/002_index_route.t @@ -0,0 +1,16 @@ +use strict; +use warnings; + +use [d2% appname %2d]; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +my $app = [d2% appname %2d]->to_app; +ok( is_coderef($app), 'Got app' ); + +my $test = Plack::Test->create($app); +my $res = $test->request( GET '/' ); + +ok( $res->is_success, '[GET /] successful' ); diff --git a/share/skel/views/index.tt b/share/skel/views/index.tt new file mode 100644 index 00000000..51e32a2f --- /dev/null +++ b/share/skel/views/index.tt @@ -0,0 +1,148 @@ + +<!-- + Credit goes to the Ruby on Rails team for this page + has been heavily based on the default Rails page that is + built with a scaffolded application. + + Thanks a lot to them for their work. + + See Ruby on Rails if you want a kickass framework in Ruby: + http://www.rubyonrails.org/ +--> + +<div id="page"> + <div id="sidebar"> + <ul id="sidebar-items"> + <li> + <h3>Join the community</h3> + <ul class="links"> + + <li><a href="http://perldancer.org/">PerlDancer</a></li> + <li><a href="http://twitter.com/PerlDancer/">Official Twitter</a></li> + <li><a href="https://github.com/PerlDancer/Dancer2/">GitHub Community</a></li> + </ul> + </li> + + <li> + <h3>Browse the documentation</h3> + + <ul class="links"> + <li><a + href="https://metacpan.org/pod/Dancer2::Manual">Introduction</a></li> + <li><a href="https://metacpan.org/pod/Dancer2::Cookbook">Cookbook</a></li> + <li><a + href="https://metacpan.org/pod/Dancer2::Tutorial" + title="a tutorial to build a small blog engine with Dancer">Tutorial</a></li> + </ul> + </li> + + <li> + <h3>Your application's environment</h3> + + <ul> + <li>Location: <span class="filepath">[d2% appdir %2d]</span></li> + <li>Template engine: <span class="app-info"><% settings.template %></span></li> + <li>Logger: <span class="app-info"><% settings.logger %></span></li> + <li>Environment: <span class="app-info"><% settings.environment %></span></li> + </ul> + + </li> + </ul> + + </div> + + <div id="content"> + <div id="header"> + <h1>Perl is dancing</h1> + <h2>You’ve joined the dance floor!</h2> + </div> + + <div id="getting-started"> + <h1>Getting started</h1> + <h2>Here’s how to get dancing:</h2> + + <h3><a href="#" id="about_env_link">About your application's environment</a></h3> + + <div id="about-content" style="display: none;"> + <table> + <tbody> + <tr> + <td>Perl version</td> + <td><span class="app-info"><% perl_version %></span></td> + </tr> + <tr> + <td>Dancer2 version</td> + <td><span class="app-info"><% dancer_version %></span></td> + </tr> + <tr> + <td>Backend</td> + <td><span class="app-info"><% settings.apphandler %></span></td> + </tr> + <tr> + <td>Appdir</td> + <td><span class="filepath">[d2% appdir %2d]</span></td> + </tr> + <tr> + <td>Template engine</td> + <td><span class="app-info"><% settings.template %></span></td> + </tr> + <tr> + <td>Logger engine</td> + <td><span class="app-info"><% settings.logger %></span></td> + </tr> + <tr> + <td>Running environment</td> + <td><span class="app-info"><% settings.environment %></span></td> + </tr> + </tbody> + </table> + </div> + + <script type="text/javascript"> + $('#about_env_link').click(function() { + $('#about-content').slideToggle('fast', function() { + // ok + }); + return false; + }); + </script> + + + <ol> + <li> + <h2>Tune your application</h2> + + <p> + Your application is configured via a global configuration file, + <span class="filepath">config.yml</span> and an "environment" configuration file, + <span class="filepath">environments/development.yml</span>. Edit those files if you + want to change the settings of your application. + </p> + </li> + + <li> + <h2>Add your own routes</h2> + + <p> + The default route that displays this page can be removed, + it's just here to help you get started. The template used to + generate this content is located in + <span class="filepath">views/index.tt</span>. + You can add some routes to <span class="filepath">[d2% appfile %2d]</span>. + </p> + </li> + + <li> + <h2>Enjoy web development again</h2> + + <p> + Once you've made your changes, restart your standalone server + <span class="filepath">(bin/app.psgi)</span> and you're ready + to test your web application. + </p> + </li> + + </ol> + </div> + </div> + </div> diff --git a/share/skel/views/layouts/main.tt b/share/skel/views/layouts/main.tt new file mode 100644 index 00000000..2bc29368 --- /dev/null +++ b/share/skel/views/layouts/main.tt @@ -0,0 +1,22 @@ +<!DOCTYPE html> +<html lang="en"> +<head> + <meta charset="<% settings.charset %>"> + <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes"> + <title><% title %></title> + <link rel="stylesheet" href="<% request.uri_base %>/css/style.css"> + +<!-- Grab jQuery from a CDN, fall back to local if necessary --> +<script src="//code.jquery.com/jquery-3.4.1.min.js"></script> +<script type="text/javascript">/* <![CDATA[ */ + !window.jQuery && document.write('<script type="text/javascript" src="<% request.uri_base %>/javascripts/jquery.js"><\/script>') +/* ]]> */</script> + +</head> +<body> +<% content %> +<div id="footer"> +Powered by <a href="http://perldancer.org/">Dancer2</a> <% dancer_version %> +</div> +</body> +</html> diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 00000000..a0ab3db4 --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,153 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 + +use Test::More; + +plan tests => 58 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +my @module_files = ( + 'Dancer2.pm', + 'Dancer2/CLI.pm', + 'Dancer2/CLI/Command/gen.pm', + 'Dancer2/CLI/Command/version.pm', + 'Dancer2/Core.pm', + 'Dancer2/Core/App.pm', + 'Dancer2/Core/Cookie.pm', + 'Dancer2/Core/DSL.pm', + 'Dancer2/Core/Dispatcher.pm', + 'Dancer2/Core/Error.pm', + 'Dancer2/Core/Factory.pm', + 'Dancer2/Core/HTTP.pm', + 'Dancer2/Core/Hook.pm', + 'Dancer2/Core/MIME.pm', + 'Dancer2/Core/Request.pm', + 'Dancer2/Core/Request/Upload.pm', + 'Dancer2/Core/Response.pm', + 'Dancer2/Core/Response/Delayed.pm', + 'Dancer2/Core/Role/ConfigReader.pm', + 'Dancer2/Core/Role/DSL.pm', + 'Dancer2/Core/Role/Engine.pm', + 'Dancer2/Core/Role/Handler.pm', + 'Dancer2/Core/Role/HasLocation.pm', + 'Dancer2/Core/Role/Hookable.pm', + 'Dancer2/Core/Role/Logger.pm', + 'Dancer2/Core/Role/Serializer.pm', + 'Dancer2/Core/Role/SessionFactory.pm', + 'Dancer2/Core/Role/SessionFactory/File.pm', + 'Dancer2/Core/Role/StandardResponses.pm', + 'Dancer2/Core/Role/Template.pm', + 'Dancer2/Core/Route.pm', + 'Dancer2/Core/Runner.pm', + 'Dancer2/Core/Session.pm', + 'Dancer2/Core/Time.pm', + 'Dancer2/Core/Types.pm', + 'Dancer2/FileUtils.pm', + 'Dancer2/Handler/AutoPage.pm', + 'Dancer2/Handler/File.pm', + 'Dancer2/Logger/Capture.pm', + 'Dancer2/Logger/Capture/Trap.pm', + 'Dancer2/Logger/Console.pm', + 'Dancer2/Logger/Diag.pm', + 'Dancer2/Logger/File.pm', + 'Dancer2/Logger/Note.pm', + 'Dancer2/Logger/Null.pm', + 'Dancer2/Plugin.pm', + 'Dancer2/Serializer/Dumper.pm', + 'Dancer2/Serializer/JSON.pm', + 'Dancer2/Serializer/Mutable.pm', + 'Dancer2/Serializer/YAML.pm', + 'Dancer2/Session/Simple.pm', + 'Dancer2/Session/YAML.pm', + 'Dancer2/Template/Implementation/ForkedTiny.pm', + 'Dancer2/Template/Simple.pm', + 'Dancer2/Template/TemplateToolkit.pm', + 'Dancer2/Template/Tiny.pm', + 'Dancer2/Test.pm' +); + +my @scripts = ( + 'script/dancer2' +); + +# no fake home requested + +my @switches = ( + -d 'blib' ? '-Mblib' : '-Ilib', +); + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L<perlfaq8/How can I capture STDERR from an external command?> + my $stderr = IO::Handle->new; + + diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } + $^X, @switches, '-e', "require q[$lib]")) + if $ENV{PERL_COMPILE_TEST_DEBUG}; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ + and not eval { +require blib; blib->VERSION('1.01') }; + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + +foreach my $file (@scripts) +{ SKIP: { + open my $fh, '<', $file or warn("Unable to open $file: $!"), next; + my $line = <$fh>; + + close $fh and skip("$file isn't perl", 1) unless $line =~ /^#!\s*(?:\S*perl\S*)((?:\s+-\w*)*)(?:\s*#.*)?$/; + @switches = (@switches, split(' ', $1)) if $1; + + close $fh and skip("$file uses -T; not testable with PERL5LIB", 1) + if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB}; + + my $stderr = IO::Handle->new; + + diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } + $^X, @switches, '-c', $file)) + if $ENV{PERL_COMPILE_TEST_DEBUG}; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$file compiled ok"); + + shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ + and not eval { +require blib; blib->VERSION('1.01') }; + + # in older perls, -c output is simply the file portion of the path being tested + if (@_warnings = grep { !/\bsyntax OK$/ } + grep { chomp; $_ ne (File::Spec->splitpath($file))[2] } @_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} } + + + +is(scalar(@warnings), 0, 'no warnings found') + or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; + + diff --git a/t/00-report-prereqs.dd b/t/00-report-prereqs.dd new file mode 100644 index 00000000..70379f51 --- /dev/null +++ b/t/00-report-prereqs.dd @@ -0,0 +1,127 @@ +do { my $x = { + 'build' => { + 'requires' => { + 'ExtUtils::MakeMaker' => '7.1101', + 'Test::CPAN::Meta' => '0' + } + }, + 'configure' => { + 'requires' => { + 'CPAN::Meta::Requirements' => '2.120620', + 'ExtUtils::MakeMaker' => '7.1101', + 'File::ShareDir::Install' => '0.06', + 'Module::Metadata' => '0' + } + }, + 'develop' => { + 'requires' => { + 'AnyEvent' => '0', + 'CBOR::XS' => '0', + 'Class::Method::Modifiers' => '0', + 'Dist::Zilla::Plugin::Test::UnusedVars' => '0', + 'Perl::Tidy' => '0', + 'Test::CPAN::Meta' => '0', + 'Test::Memory::Cycle' => '0', + 'Test::MockTime' => '0', + 'Test::More' => '0.88', + 'Test::NoTabs' => '0', + 'Test::Perl::Critic' => '0', + 'Test::Pod' => '1.41', + 'Test::Whitespaces' => '0', + 'YAML::XS' => '0' + } + }, + 'runtime' => { + 'conflicts' => { + 'YAML' => '1.16' + }, + 'recommends' => { + 'CGI::Deurl::XS' => '0', + 'Class::XSAccessor' => '0', + 'Cpanel::JSON::XS' => '0', + 'Crypt::URandom' => '0', + 'HTTP::XSCookies' => '0.000007', + 'HTTP::XSHeaders' => '0', + 'Math::Random::ISAAC::XS' => '0', + 'MooX::TypeTiny' => '0', + 'Pod::Simple::Search' => '0', + 'Pod::Simple::SimpleTree' => '0', + 'Scope::Upper' => '0', + 'Type::Tiny::XS' => '0', + 'URL::Encode::XS' => '0', + 'YAML::XS' => '0' + }, + 'requires' => { + 'App::Cmd::Setup' => '0', + 'Attribute::Handlers' => '0', + 'Carp' => '0', + 'Clone' => '0', + 'Config::Any' => '0', + 'Digest::SHA' => '0', + 'Encode' => '0', + 'Exporter' => '5.57', + 'Exporter::Tiny' => '0', + 'File::Basename' => '0', + 'File::Copy' => '0', + 'File::Find' => '0', + 'File::Path' => '0', + 'File::Share' => '0', + 'File::Spec' => '0', + 'File::Temp' => '0', + 'HTTP::Date' => '0', + 'HTTP::Headers::Fast' => '0.21', + 'HTTP::Tiny' => '0', + 'Hash::Merge::Simple' => '0', + 'Hash::MultiValue' => '0', + 'Import::Into' => '0', + 'JSON::MaybeXS' => '0', + 'List::Util' => '1.29', + 'MIME::Base64' => '3.13', + 'Module::Runtime' => '0', + 'Moo' => '2.000000', + 'Moo::Role' => '0', + 'POSIX' => '0', + 'Plack' => '1.0040', + 'Plack::Middleware::FixMissingBodyInRedirect' => '0', + 'Plack::Middleware::RemoveRedundantBody' => '0', + 'Ref::Util' => '0', + 'Role::Tiny' => '2.000000', + 'Safe::Isa' => '0', + 'Sub::Quote' => '0', + 'Template' => '0', + 'Template::Tiny' => '0', + 'Test::Builder' => '0', + 'Test::More' => '0.92', + 'Type::Tiny' => '1.000006', + 'Types::Standard' => '0', + 'URI::Escape' => '0', + 'YAML' => '0.86', + 'parent' => '0' + }, + 'suggests' => { + 'Fcntl' => '0', + 'MIME::Types' => '0' + } + }, + 'test' => { + 'recommends' => { + 'CPAN::Meta' => '2.120900' + }, + 'requires' => { + 'Capture::Tiny' => '0.12', + 'ExtUtils::MakeMaker' => '7.1101', + 'File::Spec' => '0', + 'HTTP::Cookies' => '0', + 'HTTP::Headers' => '0', + 'IO::Handle' => '0', + 'IPC::Open3' => '0', + 'Template' => '0', + 'Test::Builder' => '0', + 'Test::EOL' => '0', + 'Test::Fatal' => '0', + 'Test::More' => '0.92' + } + } + }; + $x; + }
\ No newline at end of file diff --git a/t/00-report-prereqs.t b/t/00-report-prereqs.t new file mode 100644 index 00000000..c72183a1 --- /dev/null +++ b/t/00-report-prereqs.t @@ -0,0 +1,193 @@ +#!perl + +use strict; +use warnings; + +# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027 + +use Test::More tests => 1; + +use ExtUtils::MakeMaker; +use File::Spec; + +# from $version::LAX +my $lax_version_re = + qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? + | + (?:\.[0-9]+) (?:_[0-9]+)? + ) | (?: + v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? + | + (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? + ) + )/x; + +# hide optional CPAN::Meta modules from prereq scanner +# and check if they are available +my $cpan_meta = "CPAN::Meta"; +my $cpan_meta_pre = "CPAN::Meta::Prereqs"; +my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic + +# Verify requirements? +my $DO_VERIFY_PREREQS = 1; + +sub _max { + my $max = shift; + $max = ( $_ > $max ) ? $_ : $max for @_; + return $max; +} + +sub _merge_prereqs { + my ($collector, $prereqs) = @_; + + # CPAN::Meta::Prereqs object + if (ref $collector eq $cpan_meta_pre) { + return $collector->with_merged_prereqs( + CPAN::Meta::Prereqs->new( $prereqs ) + ); + } + + # Raw hashrefs + for my $phase ( keys %$prereqs ) { + for my $type ( keys %{ $prereqs->{$phase} } ) { + for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { + $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; + } + } + } + + return $collector; +} + +my @include = qw( + +); + +my @exclude = qw( + +); + +# Add static prereqs to the included modules list +my $static_prereqs = do './t/00-report-prereqs.dd'; + +# Merge all prereqs (either with ::Prereqs or a hashref) +my $full_prereqs = _merge_prereqs( + ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), + $static_prereqs +); + +# Add dynamic prereqs to the included modules list (if we can) +my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; +my $cpan_meta_error; +if ( $source && $HAS_CPAN_META + && (my $meta = eval { CPAN::Meta->load_file($source) } ) +) { + $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); +} +else { + $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) + $source = 'static metadata'; +} + +my @full_reports; +my @dep_errors; +my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; + +# Add static includes into a fake section +for my $mod (@include) { + $req_hash->{other}{modules}{$mod} = 0; +} + +for my $phase ( qw(configure build test runtime develop other) ) { + next unless $req_hash->{$phase}; + next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); + + for my $type ( qw(requires recommends suggests conflicts modules) ) { + next unless $req_hash->{$phase}{$type}; + + my $title = ucfirst($phase).' '.ucfirst($type); + my @reports = [qw/Module Want Have/]; + + for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { + next if $mod eq 'perl'; + next if grep { $_ eq $mod } @exclude; + + my $file = $mod; + $file =~ s{::}{/}g; + $file .= ".pm"; + my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; + + my $want = $req_hash->{$phase}{$type}{$mod}; + $want = "undef" unless defined $want; + $want = "any" if !$want && $want == 0; + + my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; + + if ($prefix) { + my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); + $have = "undef" unless defined $have; + push @reports, [$mod, $want, $have]; + + if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { + if ( $have !~ /\A$lax_version_re\z/ ) { + push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; + } + elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { + push @dep_errors, "$mod version '$have' is not in required range '$want'"; + } + } + } + else { + push @reports, [$mod, $want, "missing"]; + + if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { + push @dep_errors, "$mod is not installed ($req_string)"; + } + } + } + + if ( @reports ) { + push @full_reports, "=== $title ===\n\n"; + + my $ml = _max( map { length $_->[0] } @reports ); + my $wl = _max( map { length $_->[1] } @reports ); + my $hl = _max( map { length $_->[2] } @reports ); + + if ($type eq 'modules') { + splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; + } + else { + splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; + } + + push @full_reports, "\n"; + } + } +} + +if ( @full_reports ) { + diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; +} + +if ( $cpan_meta_error || @dep_errors ) { + diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; +} + +if ( $cpan_meta_error ) { + my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; + diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; +} + +if ( @dep_errors ) { + diag join("\n", + "\nThe following REQUIRED prerequisites were not satisfied:\n", + @dep_errors, + "\n" + ); +} + +pass; + +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/app.t b/t/app.t new file mode 100644 index 00000000..1081d2a9 --- /dev/null +++ b/t/app.t @@ -0,0 +1,216 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Dancer2; +use Dancer2::Core::App; +use Dancer2::Core::Dispatcher; +use Dancer2::Core::Hook; +use Dancer2::FileUtils; +use File::Spec; + +# our app/dispatcher object +my $app = Dancer2::Core::App->new( name => 'main', ); +$app->setting( show_errors => 1 ); # enable show errors +my $dispatcher = Dancer2::Core::Dispatcher->new( apps => [$app] ); + +# first basic tests +isa_ok $app, 'Dancer2::Core::App'; + +# some routes to play with +my @routes = ( + { method => 'get', + regexp => '/', + code => sub {'/'}, + }, + { method => 'get', + regexp => '/blog', + code => sub {'/blog'}, + }, +); + +# testing with and without prefixes +for my $p ( '/', '/mywebsite' ) { + for my $r (@routes) { + $app->prefix($p); + $app->add_route(%$r); + } +} + +is $app->environment, 'development'; + +my $routes_regexps = $app->routes_regexps_for('get'); +is( scalar(@$routes_regexps), 4, "route regexps are OK" ); + +for my $path ( '/', '/blog', '/mywebsite/', '/mywebsite/blog', ) { + my $env = { + REQUEST_METHOD => 'GET', + PATH_INFO => $path + }; + + my $expected = { + '/' => '/', + '/blog' => '/blog', + '/mywebsite/' => '/', + '/mywebsite/blog' => '/blog', + }; + + my $resp = $dispatcher->dispatch($env); + is $resp->[0], 200, 'got a 200'; + is $resp->[2][0], $expected->{$path}, 'got expected route'; +} + +note "testing lexical prefixes"; + +# clear the prefix in $app (and by the way, makes sure it works when prefix is +# undef). +$app->prefix(undef); + +# nested prefixes bitches! +$app->lexical_prefix( + '/foo' => sub { + $app->add_route( + method => 'get', + regexp => '/', + code => sub {'/foo/'} + ); + + $app->add_route( + method => 'get', + regexp => '/second', + code => sub {'/foo/second'} + ); + + $app->lexical_prefix( + '/bar' => sub { + $app->add_route( + method => 'get', + regexp => '/', + code => sub {'/foo/bar'} + ); + $app->add_route( + method => 'get', + regexp => '/second', + code => sub {'/foo/bar/second'} + ); + } + ); + }, +); + +# to make sure the lexical prefix did not crash anything +$app->add_route( + method => 'get', + regexp => '/root', + code => sub {'/root'} +); + +# make sure a meaningless lexical prefix is ignored +$app->lexical_prefix( + '/' => sub { + $app->add_route( + method => 'get', + regexp => '/somewhere', + code => sub {'/somewhere'}, + ); + } +); + +for + my $path ( '/foo/', '/foo/second', '/foo/bar/second', '/root', '/somewhere' ) +{ + my $env = { + REQUEST_METHOD => 'GET', + PATH_INFO => $path, + }; + + my $resp = $dispatcher->dispatch($env); + is $resp->[0], 200, 'got a 200'; + is $resp->[2][0], $path, 'got expected route'; +} + +note "test a failure in the callback of a lexical prefix"; +like( + exception { + $app->lexical_prefix( '/test' => sub { Failure->game_over() } ); + }, + qr{Unable to run the callback for prefix '/test': Can't locate object method "game_over" via package "Failure"}, + "caught an exception in the lexical prefix callback", +); + +$app->add_hook( + Dancer2::Core::Hook->new( + name => 'before', + code => sub {1}, + ) +); + +$app->add_hook( + Dancer2::Core::Hook->new( + name => 'before', + code => sub { Foo->failure; }, + ) +); + +$app->compile_hooks; +my $env = { + REQUEST_METHOD => 'GET', + PATH_INFO => '/', +}; + +like( + $dispatcher->dispatch($env)->[2][0], + qr/Exception caught in 'core.app.before_request' filter: Hook error: Can't locate object method "failure"/, + 'before filter nonexistent method failure', +); + +$app->replace_hook( 'core.app.before_request', [ sub {1} ] ); +$app->compile_hooks; +$env = { + REQUEST_METHOD => 'GET', + PATH_INFO => '/', +}; + +# test duplicate routes when the path is a regex +$app = Dancer2::Core::App->new( name => 'main' ); +my $regexp_route = { + method => 'get', 'regexp' => qr!/(\d+)!, code => sub {1} +}; +$app->add_route(%$regexp_route); + +# try to get an invalid engine +eval {$app->engine('foo')}; +like( + $@, + qr/^Engine 'foo' is not supported/, + "Engine 'foo' does not exist", +); + +my $tmpl_engine = $app->engine('template'); +ok $tmpl_engine, "Template engine is defined"; + +ok !$app->has_serializer_engine, "Serializer engine does not exist"; + +is_deeply( + $app->_get_config_for_engine('NonExistent'), + {}, + 'Empty configuration for nonexistent engine', +); + +# TODO: not such an intelligent check, this one... +# set configuration for an engine +$app->config->{'engines'}{'template'}{'Tiny'}{'hello'} = 'world'; + +is_deeply( + $app->_get_config_for_engine( template => 'Tiny', $app->config ), + { hello => 'world' }, + '_get_config_for_engine can find the right configuration', +); + +is( + File::Spec->canonpath( $app->caller ), + File::Spec->catfile(t => 'app.t'), + 'Correct caller for app', +); + +done_testing; diff --git a/t/app/t1/bin/app.psgi b/t/app/t1/bin/app.psgi new file mode 100644 index 00000000..ef833528 --- /dev/null +++ b/t/app/t1/bin/app.psgi @@ -0,0 +1,6 @@ +#!perl + +use Dancer2; +use App1; + +start; diff --git a/t/app/t1/config.yml b/t/app/t1/config.yml new file mode 100644 index 00000000..b9fc7732 --- /dev/null +++ b/t/app/t1/config.yml @@ -0,0 +1,2 @@ +app: + config: ok diff --git a/t/app/t1/lib/App1.pm b/t/app/t1/lib/App1.pm new file mode 100644 index 00000000..62a86f3c --- /dev/null +++ b/t/app/t1/lib/App1.pm @@ -0,0 +1,6 @@ +package App1; +use strict; +use warnings; +use Dancer2; + +1; diff --git a/t/app/t1/lib/Sub/App2.pm b/t/app/t1/lib/Sub/App2.pm new file mode 100644 index 00000000..908b632f --- /dev/null +++ b/t/app/t1/lib/Sub/App2.pm @@ -0,0 +1,6 @@ +package Sub::App2; +use strict; +use warnings; +use Dancer2; + +1; diff --git a/t/app/t2/.dancer b/t/app/t2/.dancer new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/t/app/t2/.dancer @@ -0,0 +1 @@ + diff --git a/t/app/t2/config.yml b/t/app/t2/config.yml new file mode 100644 index 00000000..b9fc7732 --- /dev/null +++ b/t/app/t2/config.yml @@ -0,0 +1,2 @@ +app: + config: ok diff --git a/t/app/t2/lib/App3.pm b/t/app/t2/lib/App3.pm new file mode 100644 index 00000000..7680b204 --- /dev/null +++ b/t/app/t2/lib/App3.pm @@ -0,0 +1,5 @@ +package App3; +use strict; +use warnings; +use Dancer2; +1; diff --git a/t/app_alone.t b/t/app_alone.t new file mode 100644 index 00000000..5fa05f06 --- /dev/null +++ b/t/app_alone.t @@ -0,0 +1,25 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 3; +use Plack::Test; +use HTTP::Request::Common; + +{ + package MyApp; + use Dancer2; + + get '/' => sub {'OK'}; +} + +my $app = MyApp->to_app; +isa_ok( $app, 'CODE' ); + +test_psgi $app, sub { + my $cb = shift; + is( $cb->( GET '/' )->code, 200, '[GET /] Correct status' ); + is( $cb->( GET '/' )->content, 'OK', '[GET /] Correct content' ); +}; + diff --git a/t/author-no-tabs.t b/t/author-no-tabs.t new file mode 100644 index 00000000..9ed89298 --- /dev/null +++ b/t/author-no-tabs.t @@ -0,0 +1,366 @@ + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 + +use Test::More 0.88; +use Test::NoTabs; + +my @files = ( + 'lib/Dancer2.pm', + 'lib/Dancer2/CLI.pm', + 'lib/Dancer2/CLI/Command/gen.pm', + 'lib/Dancer2/CLI/Command/version.pm', + 'lib/Dancer2/Config.pod', + 'lib/Dancer2/Cookbook.pod', + 'lib/Dancer2/Core.pm', + 'lib/Dancer2/Core/App.pm', + 'lib/Dancer2/Core/Cookie.pm', + 'lib/Dancer2/Core/DSL.pm', + 'lib/Dancer2/Core/Dispatcher.pm', + 'lib/Dancer2/Core/Error.pm', + 'lib/Dancer2/Core/Factory.pm', + 'lib/Dancer2/Core/HTTP.pm', + 'lib/Dancer2/Core/Hook.pm', + 'lib/Dancer2/Core/MIME.pm', + 'lib/Dancer2/Core/Request.pm', + 'lib/Dancer2/Core/Request/Upload.pm', + 'lib/Dancer2/Core/Response.pm', + 'lib/Dancer2/Core/Response/Delayed.pm', + 'lib/Dancer2/Core/Role/ConfigReader.pm', + 'lib/Dancer2/Core/Role/DSL.pm', + 'lib/Dancer2/Core/Role/Engine.pm', + 'lib/Dancer2/Core/Role/Handler.pm', + 'lib/Dancer2/Core/Role/HasLocation.pm', + 'lib/Dancer2/Core/Role/Hookable.pm', + 'lib/Dancer2/Core/Role/Logger.pm', + 'lib/Dancer2/Core/Role/Serializer.pm', + 'lib/Dancer2/Core/Role/SessionFactory.pm', + 'lib/Dancer2/Core/Role/SessionFactory/File.pm', + 'lib/Dancer2/Core/Role/StandardResponses.pm', + 'lib/Dancer2/Core/Role/Template.pm', + 'lib/Dancer2/Core/Route.pm', + 'lib/Dancer2/Core/Runner.pm', + 'lib/Dancer2/Core/Session.pm', + 'lib/Dancer2/Core/Time.pm', + 'lib/Dancer2/Core/Types.pm', + 'lib/Dancer2/FileUtils.pm', + 'lib/Dancer2/Handler/AutoPage.pm', + 'lib/Dancer2/Handler/File.pm', + 'lib/Dancer2/Logger/Capture.pm', + 'lib/Dancer2/Logger/Capture/Trap.pm', + 'lib/Dancer2/Logger/Console.pm', + 'lib/Dancer2/Logger/Diag.pm', + 'lib/Dancer2/Logger/File.pm', + 'lib/Dancer2/Logger/Note.pm', + 'lib/Dancer2/Logger/Null.pm', + 'lib/Dancer2/Manual.pod', + 'lib/Dancer2/Manual/Deployment.pod', + 'lib/Dancer2/Manual/Migration.pod', + 'lib/Dancer2/Manual/Testing.pod', + 'lib/Dancer2/Plugin.pm', + 'lib/Dancer2/Plugins.pod', + 'lib/Dancer2/Policy.pod', + 'lib/Dancer2/Serializer/Dumper.pm', + 'lib/Dancer2/Serializer/JSON.pm', + 'lib/Dancer2/Serializer/Mutable.pm', + 'lib/Dancer2/Serializer/YAML.pm', + 'lib/Dancer2/Session/Simple.pm', + 'lib/Dancer2/Session/YAML.pm', + 'lib/Dancer2/Template/Implementation/ForkedTiny.pm', + 'lib/Dancer2/Template/Simple.pm', + 'lib/Dancer2/Template/TemplateToolkit.pm', + 'lib/Dancer2/Template/Tiny.pm', + 'lib/Dancer2/Test.pm', + 'lib/Dancer2/Tutorial.pod', + 'script/dancer2', + 't/00-compile.t', + 't/00-report-prereqs.dd', + 't/00-report-prereqs.t', + 't/app.t', + 't/app/t1/bin/app.psgi', + 't/app/t1/config.yml', + 't/app/t1/lib/App1.pm', + 't/app/t1/lib/Sub/App2.pm', + 't/app/t2/.dancer', + 't/app/t2/config.yml', + 't/app/t2/lib/App3.pm', + 't/app_alone.t', + 't/auto_page.t', + 't/caller.t', + 't/charset_server.t', + 't/classes/Dancer2-Core-Factory/new.t', + 't/classes/Dancer2-Core-Hook/new.t', + 't/classes/Dancer2-Core-Request/new.t', + 't/classes/Dancer2-Core-Request/serializers.t', + 't/classes/Dancer2-Core-Response-Delayed/after_hooks.t', + 't/classes/Dancer2-Core-Response-Delayed/new.t', + 't/classes/Dancer2-Core-Response/new_from.t', + 't/classes/Dancer2-Core-Role-Engine/with.t', + 't/classes/Dancer2-Core-Role-Handler/with.t', + 't/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/bin/.exists', + 't/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/lib/fake/inner/dir/.exists', + 't/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/.dancer', + 't/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/fakescript.pl', + 't/classes/Dancer2-Core-Role-HasLocation/with.t', + 't/classes/Dancer2-Core-Role-Serializer/with.t', + 't/classes/Dancer2-Core-Role-StandardResponses/with.t', + 't/classes/Dancer2-Core-Route/base.t', + 't/classes/Dancer2-Core-Route/deprecated_param_keys.t', + 't/classes/Dancer2-Core-Route/match.t', + 't/classes/Dancer2-Core-Runner/environment.t', + 't/classes/Dancer2-Core-Runner/new.t', + 't/classes/Dancer2-Core-Runner/psgi_app.t', + 't/classes/Dancer2-Core/camelize.t', + 't/classes/Dancer2/import-pragmas.t', + 't/classes/Dancer2/import.t', + 't/config.yml', + 't/config/config.yml', + 't/config/environments/failure.yml', + 't/config/environments/merging.yml', + 't/config/environments/production.yml', + 't/config/environments/staging.json', + 't/config2/config.yml', + 't/config2/config_local.yml', + 't/config2/environments/lconfig.yml', + 't/config2/environments/lconfig_local.yml', + 't/config_multiapp.t', + 't/config_reader.t', + 't/config_settings.t', + 't/context-in-before.t', + 't/cookie.t', + 't/corpus/pretty/505.tt', + 't/corpus/pretty/relative.tt', + 't/corpus/pretty_public/404.html', + 't/corpus/pretty_public/510.html', + 't/corpus/static/index.html', + 't/custom_dsl.t', + 't/dancer-test.t', + 't/dancer-test/config.yml', + 't/deserialize.t', + 't/disp_named_capture.t', + 't/dispatcher.t', + 't/dsl/any.t', + 't/dsl/app.t', + 't/dsl/content.t', + 't/dsl/delayed.t', + 't/dsl/error_template.t', + 't/dsl/extend.t', + 't/dsl/extend_config/config.yml', + 't/dsl/halt.t', + 't/dsl/halt_with_param.t', + 't/dsl/json.t', + 't/dsl/parameters.t', + 't/dsl/pass.t', + 't/dsl/path.t', + 't/dsl/request.t', + 't/dsl/route_retvals.t', + 't/dsl/send_as.t', + 't/dsl/send_file.t', + 't/dsl/splat.t', + 't/dsl/to_app.t', + 't/engine.t', + 't/error.t', + 't/examples/hello_world.t', + 't/examples/simple_calculator.t', + 't/factory.t', + 't/file_utils.t', + 't/forward.t', + 't/forward_before_hook.t', + 't/forward_hmv_params.t', + 't/forward_test_tcp.t', + 't/hooks.t', + 't/http_methods.t', + 't/http_status.t', + 't/issues/config.yml', + 't/issues/gh-1013/gh-1013.t', + 't/issues/gh-1013/views/t.tt', + 't/issues/gh-1046/config.yml', + 't/issues/gh-1046/gh-1046.t', + 't/issues/gh-1070.t', + 't/issues/gh-1098.t', + 't/issues/gh-1216/gh-1216.t', + 't/issues/gh-1216/lib/App.pm', + 't/issues/gh-1216/lib/App/Extra.pm', + 't/issues/gh-1216/lib/Dancer2/Plugin/Null.pm', + 't/issues/gh-1226/gh-1226.t', + 't/issues/gh-1226/lib/App.pm', + 't/issues/gh-1226/lib/App/Extra.pm', + 't/issues/gh-1226/lib/Dancer2/Plugin/Test/AccessDSL.pm', + 't/issues/gh-1230/gh-1230.t', + 't/issues/gh-1230/lib/App.pm', + 't/issues/gh-1230/lib/App/Extra.pm', + 't/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessDSL.pm', + 't/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessPluginDSL.pm', + 't/issues/gh-1232.t', + 't/issues/gh-596.t', + 't/issues/gh-634.t', + 't/issues/gh-639/fails/.dancer', + 't/issues/gh-639/fails/config.yml', + 't/issues/gh-639/fails/issue.t', + 't/issues/gh-639/succeeds/.dancer', + 't/issues/gh-639/succeeds/config.yml', + 't/issues/gh-639/succeeds/issue.t', + 't/issues/gh-650/gh-650.t', + 't/issues/gh-650/views/environment_setting.tt', + 't/issues/gh-723.t', + 't/issues/gh-730.t', + 't/issues/gh-762.t', + 't/issues/gh-762/views/404.tt', + 't/issues/gh-794.t', + 't/issues/gh-797.t', + 't/issues/gh-799.t', + 't/issues/gh-811.t', + 't/issues/gh-931.t', + 't/issues/gh-936.t', + 't/issues/gh-936/views/error.tt', + 't/issues/gh-944.t', + 't/issues/gh-975/config.yml', + 't/issues/gh-975/gh-975.t', + 't/issues/gh-975/test_public_dir/test.txt', + 't/issues/memleak/die_in_hooks.t', + 't/issues/vars-in-forward.t', + 't/lib/App1.pm', + 't/lib/App2.pm', + 't/lib/Dancer2/Plugin/Bar.pm', + 't/lib/Dancer2/Plugin/DancerPlugin.pm', + 't/lib/Dancer2/Plugin/DefineKeywords.pm', + 't/lib/Dancer2/Plugin/EmptyPlugin.pm', + 't/lib/Dancer2/Plugin/Foo.pm', + 't/lib/Dancer2/Plugin/FooPlugin.pm', + 't/lib/Dancer2/Plugin/Hookee.pm', + 't/lib/Dancer2/Plugin/OnPluginImport.pm', + 't/lib/Dancer2/Plugin/PluginWithImport.pm', + 't/lib/Dancer2/Plugin/Polite.pm', + 't/lib/Dancer2/Session/SimpleNoChangeId.pm', + 't/lib/Foo.pm', + 't/lib/MyDancerDSL.pm', + 't/lib/PoC/Plugin/Polite.pm', + 't/lib/SubApp1.pm', + 't/lib/SubApp2.pm', + 't/lib/TestApp.pm', + 't/lib/TestPod.pm', + 't/lib/TestTypeLibrary.pm', + 't/lib/poc.pm', + 't/lib/poc2.pm', + 't/log_die_before_hook.t', + 't/log_levels.t', + 't/logger.t', + 't/logger_console.t', + 't/memory_cycles.t', + 't/mime.t', + 't/multi_apps.t', + 't/multi_apps_forward.t', + 't/multiapp_template_hooks.t', + 't/named_apps.t', + 't/no_default_middleware.t', + 't/plugin2/basic-2.t', + 't/plugin2/basic.t', + 't/plugin2/define-keywords.t', + 't/plugin2/find_plugin.t', + 't/plugin2/from-config.t', + 't/plugin2/hooks.t', + 't/plugin2/inside-plugin.t', + 't/plugin2/keywords-hooks-namespace.t', + 't/plugin2/memory_cycles.t', + 't/plugin2/no-app-munging.t', + 't/plugin2/no-clobbering.t', + 't/plugin2/no-config.t', + 't/plugin2/with-plugins.t', + 't/plugin_import.t', + 't/plugin_multiple_apps.t', + 't/plugin_register.t', + 't/plugin_syntax.t', + 't/prepare_app.t', + 't/psgi_app.t', + 't/psgi_app_forward_and_pass.t', + 't/public/file.txt', + 't/redirect.t', + 't/request.t', + 't/request_make_forward_to.t', + 't/request_upload.t', + 't/response.t', + 't/roles/hook.t', + 't/route-pod-coverage/route-pod-coverage.t', + 't/scope_problems/config.yml', + 't/scope_problems/dispatcher_internal_request.t', + 't/scope_problems/keywords_before_template_hook.t', + 't/scope_problems/session_is_cleared.t', + 't/scope_problems/views/500.tt', + 't/scope_problems/with_return_dies.t', + 't/serializer.t', + 't/serializer_json.t', + 't/serializer_mutable.t', + 't/serializer_mutable_custom.t', + 't/session_bad_client_cookie.t', + 't/session_config.t', + 't/session_engines.t', + 't/session_forward.t', + 't/session_hooks.t', + 't/session_hooks_no_change_id.t', + 't/session_in_template.t', + 't/session_lifecycle.t', + 't/session_object.t', + 't/shared_engines.t', + 't/static_content.t', + 't/template.t', + 't/template_default_tokens.t', + 't/template_ext.t', + 't/template_name.t', + 't/template_simple.t', + 't/template_tiny/01_compile.t', + 't/template_tiny/02_trivial.t', + 't/template_tiny/03_samples.t', + 't/template_tiny/04_compat.t', + 't/template_tiny/05_preparse.t', + 't/template_tiny/samples/01_hello.tt', + 't/template_tiny/samples/01_hello.txt', + 't/template_tiny/samples/01_hello.var', + 't/template_tiny/samples/02_null.tt', + 't/template_tiny/samples/02_null.txt', + 't/template_tiny/samples/02_null.var', + 't/template_tiny/samples/03_chomp.tt', + 't/template_tiny/samples/03_chomp.txt', + 't/template_tiny/samples/03_chomp.var', + 't/template_tiny/samples/04_nested.tt', + 't/template_tiny/samples/04_nested.txt', + 't/template_tiny/samples/04_nested.var', + 't/template_tiny/samples/05_condition.tt', + 't/template_tiny/samples/05_condition.txt', + 't/template_tiny/samples/05_condition.var', + 't/template_tiny/samples/06_object.tt', + 't/template_tiny/samples/06_object.txt', + 't/template_tiny/samples/06_object.var', + 't/template_tiny/samples/07_nesting.tt', + 't/template_tiny/samples/07_nesting.txt', + 't/template_tiny/samples/07_nesting.var', + 't/template_tiny/samples/08_foreach.tt', + 't/template_tiny/samples/08_foreach.txt', + 't/template_tiny/samples/08_foreach.var', + 't/template_tiny/samples/09_trim.tt', + 't/template_tiny/samples/09_trim.txt', + 't/template_tiny/samples/09_trim.var', + 't/time.t', + 't/types.t', + 't/uri_for.t', + 't/vars.t', + 't/views/auto_page.tt', + 't/views/beforetemplate.tt', + 't/views/folder/page.tt', + 't/views/index.tt', + 't/views/layouts/main.tt', + 't/views/session_in_template.tt', + 't/views/template_simple_index.tt', + 't/views/tokens.tt' +); + +notabs_ok($_) foreach @files; +done_testing; diff --git a/t/author-pod-syntax.t b/t/author-pod-syntax.t new file mode 100644 index 00000000..2233af08 --- /dev/null +++ b/t/author-pod-syntax.t @@ -0,0 +1,15 @@ +#!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(); diff --git a/t/auto_page.t b/t/auto_page.t new file mode 100644 index 00000000..d1f5555e --- /dev/null +++ b/t/auto_page.t @@ -0,0 +1,99 @@ +use strict; +use warnings; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package AutoPageTest; + use Dancer2; + + set auto_page => 1; + set views => 't/views'; + set layout => 'main'; + set charset => 'UTF-8'; +} + + +my @engines = ('tiny'); +eval {require Template; Template->import(); push @engines, 'template_toolkit';}; + +for my $tt_engine ( @engines ) { + # Change template engine and run tests + AutoPageTest::set( template => $tt_engine ); + subtest "autopage with template $tt_engine" => \&run_tests; +} + +sub run_tests { + my $test = Plack::Test->create( AutoPageTest->to_app ); + + { + my $r = $test->request( GET '/auto_page' ); + + is( $r->code, 200, 'Autopage found the page' ); + # ö is U+00F6 or c3 b6 when encoded as bytes + like( + $r->content, + qr/---\nHey! This is Auto Page w\x{c3}\x{b6}rking/, + '...with proper content', + ); + + is( + $r->headers->content_type, + 'text/html', + 'auto page has correct content type header', + ); + + is( + $r->headers->content_type_charset, + 'UTF-8', + 'auto page has correct charset in content type header', + ); + + is( + $r->headers->content_length, + 98, # auto_page.tt+layouts/main.tt processed. ö has two bytes in UTF-8 + 'auto page has correct content length header', + ); + } + + { + my $r = $test->request( GET '/folder/page' ); + + is( $r->code, 200, 'Autopage found the page under a folder' ); + like( + $r->content, + qr/---\nPage under folder/, + '...with proper content', + ); + } + + { + my $r = $test->request( GET '/non_existent_page' ); + is( $r->code, 404, 'Autopage doesn\'t try to render nonexistent pages' ); + } + + { + my $r = $test->request( GET '/layouts/main'); + is( $r->code, 404, 'Layouts are not served' ); + } + + { + my $r = $test->request( GET '/file.txt' ); + is( $r->code, 200, 'found file on public with autopage' ); + is( + $r->content, + "this is a public file\n", + '[GET /file.txt] Correct content', + ); + + like( + $r->headers->content_type, + qr{text/plain}, + 'public served file has correct content type header', + ); + } +} + +done_testing; diff --git a/t/caller.t b/t/caller.t new file mode 100644 index 00000000..e236e656 --- /dev/null +++ b/t/caller.t @@ -0,0 +1,30 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; +use File::Spec; + +{ + package App; + use Dancer2; + + get '/' => sub { app->caller }; + +} + +my $app = App->to_app; +test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/' ); + + is( $res->code, 200, '[GET /] Successful' ); + is( + File::Spec->canonpath( $res->content), + File::Spec->catfile(t => 'caller.t'), + 'Correct App name from caller', + ); +}; diff --git a/t/charset_server.t b/t/charset_server.t new file mode 100644 index 00000000..71be764c --- /dev/null +++ b/t/charset_server.t @@ -0,0 +1,58 @@ +use Test::More; +use strict; +use warnings; +use Encode; +use utf8; + +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + package App; + use Dancer2; + + get '/name/:name' => sub { + "Your name: " . params->{name}; + }; + + post '/name' => sub { + "Your name: " . params->{name}; + }; + + get '/unicode' => sub { + "cyrillic shcha \x{0429}",; + }; + + get '/symbols' => sub { + '⚒ ⚓ ⚔ ⚕ ⚖ ⚗ ⚘ ⚙'; + }; + + set charset => 'utf-8'; +} + +my $app = Dancer2->psgi_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( POST "/name", [ name => 'vasya'] ); + + is $res->content_type, 'text/html'; + ok $res->content_type_charset + ; # we always have charset if the setting is set + is $res->content, 'Your name: vasya'; + + $res = $cb->( GET "/unicode" ); + + is $res->content_type, 'text/html'; + is $res->content_type_charset, 'UTF-8'; + is $res->content, Encode::encode( 'utf-8', "cyrillic shcha \x{0429}" ); + + $res = $cb->( GET "/symbols" ); + is $res->content_type, 'text/html'; + is $res->content_type_charset, 'UTF-8'; + is $res->content, Encode::encode( 'utf-8', "⚒ ⚓ ⚔ ⚕ ⚖ ⚗ ⚘ ⚙" ); +}; + +done_testing(); diff --git a/t/classes/Dancer2-Core-Factory/new.t b/t/classes/Dancer2-Core-Factory/new.t new file mode 100644 index 00000000..3450da3e --- /dev/null +++ b/t/classes/Dancer2-Core-Factory/new.t @@ -0,0 +1,16 @@ +use strict; +use warnings; +use Test::More tests => 5; + +use_ok('Dancer2::Core::Factory'); + +my $factory = Dancer2::Core::Factory->new; +isa_ok( $factory, 'Dancer2::Core::Factory' ); +can_ok( $factory, 'create' ); + +my $template = Dancer2::Core::Factory->create( + 'template', 'template_toolkit', layout => 'mylayout' +); + +isa_ok( $template, 'Dancer2::Template::TemplateToolkit' ); +is( $template->{'layout'}, 'mylayout', 'Correct layout set in the template' ); diff --git a/t/classes/Dancer2-Core-Hook/new.t b/t/classes/Dancer2-Core-Hook/new.t new file mode 100644 index 00000000..95b2470d --- /dev/null +++ b/t/classes/Dancer2-Core-Hook/new.t @@ -0,0 +1,69 @@ +use strict; +use warnings; +use Test::More tests => 12; +use Test::Fatal; + +use_ok('Dancer2::Core::Hook'); + +like( + exception { Dancer2::Core::Hook->new( name => 'myname' ) }, + qr/^Missing required arguments: code/, + 'Must provide code attribute', +); + +like( + exception { Dancer2::Core::Hook->new( code => sub {1} ) }, + qr/^Missing required arguments: name/, + 'Must provide name attribute', +); + +is( + exception { + Dancer2::Core::Hook->new( name => 'myname', code => sub {1} ) + }, + undef, + 'Can create hook with name and code', +); + +{ + my $hook = Dancer2::Core::Hook->new( + name => 'before_template', + code => sub { + my $input = shift; + ::is( $input, 'input', 'Correct input for hook' ); + return 'output'; + }, + ); + + isa_ok( $hook, 'Dancer2::Core::Hook' ); + can_ok( $hook, qw<name code> ); + + is( + $hook->name, + 'before_template_render', + 'before_template becomes before_template_render', + ); + + isa_ok( $hook->code, 'CODE' ); + + is( + $hook->code->('input'), + 'output', + 'Hook returned proper output', + ); +} + +{ + my $hook = Dancer2::Core::Hook->new( + name => 'CrashingHook', + code => sub { die 'dying' }, + ); + + isa_ok( $hook, 'Dancer2::Core::Hook' ); + + like( + exception { $hook->code->() }, + qr/^Hook error: dying/, + 'Hook crashing caught', + ); +} diff --git a/t/classes/Dancer2-Core-Request/new.t b/t/classes/Dancer2-Core-Request/new.t new file mode 100644 index 00000000..a00796d1 --- /dev/null +++ b/t/classes/Dancer2-Core-Request/new.t @@ -0,0 +1,521 @@ +use strict; +use warnings; +use Test::More tests => 10; +use Test::Fatal; +use Plack::Test; +use HTTP::Request::Common; +use Plack::Builder; +use URI::Escape; + +BEGIN { use_ok('Dancer2::Core::Request') } + +sub psgi_ok { [ 200, [], ['OK'] ] } + +sub test_get_params { + my %exp_params = ( + 'name' => 'Alexis Sukrieh', + 'IRC Nickname' => 'sukria', + 'Project' => 'Perl Dancer2', + 'hash' => [ 2, 4 ], + int1 => 1, + int2 => 0, + ); + + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + + is( $request->path, '/', 'path is set' ); + is( $request->method, 'GET', 'method is set' ); + ok( $request->is_get, 'method is GET' ); + + is_deeply( + scalar( $request->params ), + \%exp_params, + 'params are OK', + ); + + is( + $request->params->{'name'}, + 'Alexis Sukrieh', + 'params accessor works', + ); + + my %params = $request->params; + is_deeply( + scalar( $request->params ), + \%params, + 'params wantarray works', + ); + + return psgi_ok; + } ); + + my $request_url = '/?' . + join '&', map {; + my $param = $_; + ref $exp_params{$param} + ? map +( uri_escape($param).'='.uri_escape($_) ), @{ $exp_params{$_} } + : uri_escape($_).'='.uri_escape( $exp_params{$param} ); + } keys %exp_params; + + ok( + $test->request( GET $request_url )->is_success, + 'Request successful', + ); +} + +sub test_post_params { + my %exp_params = ( + foo => 'bar', + name => 'john', + hash => [ 2, 4, 6 ], + ); + + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + + is( $request->path, '/', 'path is set' ); + is( $request->method, 'POST', 'method is set' ); + ok( $request->is_post, 'method is POST' ); + + like( + $request->to_string, + qr{^\[\#\d+\] POST /}, + 'Request presented well as string', + ); + + is_deeply( + scalar( $request->params ), + \%exp_params, + 'params are OK', + ); + + my %params = $request->params; + is_deeply( + scalar( $request->params ), + \%params, + 'params wantarray works', + ); + + is_deeply( + scalar( $request->params ), + \%params, + 'params wantarray works', + ); + + return psgi_ok; + } ); + + my $req = POST '/', \%exp_params; + + ok( + $test->request($req)->is_success, + 'Request successful', + ); +} + +sub test_mixed_params { + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + + my %exp_params = ( + mixed => { + x => 1, y => 2, meth => 'post', + }, + + get => { + y => 2, meth => 'get', + }, + + post => { + x => 1, meth => 'post', + }, + ); + + is( $request->path, '/', 'path is set' ); + is( $request->method, 'POST', 'method is set' ); + + is_deeply( + scalar( $request->params ), + $exp_params{'mixed'}, + 'params are OK', + ); + + is_deeply( + scalar( $request->params('body') ), + $exp_params{'post'}, + 'body params are OK', + ); + + is_deeply( + scalar( $request->params('query') ), + $exp_params{'get'}, + 'query params are OK', + ); + + return psgi_ok; + } ); + + my $req = POST '/?y=2&meth=get', + { x => 1, meth => 'post' }; + + ok( + $test->request($req)->is_success, + 'Request successful', + ); +} + +sub test_all_params { + test_get_params; + test_post_params; + test_mixed_params; +} + +subtest 'Defaults' => sub { + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + isa_ok( $request, 'Dancer2::Core::Request' ); + + can_ok( $request, 'env' ); + isa_ok( $request->env, 'HASH' ); + + # http env keys + my @http_env_keys = qw< + accept accept_charset accept_encoding accept_language + connection keep_alive referer user_agent x_requested_with + >; + + can_ok( $request, @http_env_keys ); + + is( + $request->$_, + $request->env->{"HTTP_$_"}, + "HTTP ENV key $_", + ) for @http_env_keys; + + is( + $request->agent, + $request->user_agent, + 'agent as alias to user_agent', + ); + + is( + $request->remote_address, + $request->address, + 'remote_address as alias to address', + ); + + # variables + $request->var( foo => 'bar' ); + is_deeply( + $request->vars, + { foo => 'bar' }, + 'Setting variables using DSL', + ); + + is( $request->var('foo'), 'bar', 'Read single variable' ); + + $request->var( foo => 'baz' ); + + is_deeply( + $request->vars, + { foo => 'baz' }, + 'Overwriting variables using vars() method', + ); + + is( $request->var('foo'), 'baz', 'Read variable' ); + + is( $request->path, '/defaults', 'Default path' ); + is( $request->path_info, '/defaults', 'Default path_info' ); + is( $request->method, 'GET', 'Default method' ); + + is( $request->id, 1, 'Correct request ID' ); + + my %aliases = ( + address => 'REMOTE_ADDR', + remote_host => 'REMOTE_HOST', + protocol => 'SERVER_PROTOCOL', + port => 'SERVER_PORT', + request_uri => 'REQUEST_URI', + user => 'REMOTE_USER', + script_name => 'SCRIPT_NAME', + ); + + is( + $request->$_, + $request->env->{ $aliases{$_} }, + "$_ derived from $aliases{$_}", + ) for keys %aliases; + + is( + $request->to_string, + '[#1] GET /defaults', + 'Correct to_string', + ); + + return psgi_ok; + } ); + + ok( + $test->request( GET '/defaults' )->is_success, + 'Request successful', + ); +}; + +subtest 'Create with single env' => sub { + isa_ok( + Dancer2::Core::Request->new( env => {} ), + 'Dancer2::Core::Request', + 'Create with env hash', + ); + + my $request; + isa_ok( + $request = Dancer2::Core::Request->new( + env => { REQUEST_METHOD => 'X' } + ), + 'Dancer2::Core::Request', + 'Create with single argument for env', + ); + + is( $request->method, 'X', 'env() attribute populated successfully' ); +}; + +subtest 'Serializer' => sub { + { + my $request = Dancer2::Core::Request->new( env => {} ); + can_ok( $request, qw<serializer> ); + ok( ! $request->serializer, 'No serializer set' ); + } + + { + { package Nothing; use Moo; } + + # The type check fails - BUILD is not called, no increment of _count. + ok( + exception { + Dancer2::Core::Request->new( + env => {}, + serializer => Nothing->new, + ) + }, + 'Cannot send random object to request as serializer', + ); + + { + package Serializer; + use Moo; + with 'Dancer2::Core::Role::Serializer'; + sub serialize {1} + sub deserialize {1} + has '+content_type' => ( default => sub {1} ); + } + + my $request; + is( + exception { + $request = Dancer2::Core::Request->new( + env => { REQUEST_METHOD => 'GET' }, + serializer => Serializer->new, + ) + }, + undef, + 'Can create request with serializer', + ); + + ok( $request->serializer, 'Serializer set' ); + isa_ok( $request->serializer, 'Serializer' ); + } +}; + +subtest 'Path when mounting' => sub { + my $app = builder { mount '/mount' => sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + + is( + $request->script_name, + '/mount', + 'Script name when mounted (script_name)', + ); + + is( + $request->request_uri, + '/mount/mounted_path', + 'Correct request_uri', + ); + + is( + $request->path, + '/mounted_path', + 'Full path when mounted (path)', + ); + + is( + $request->path_info, + '/mounted_path', + 'Mounted path when mounted (path_info)', + ); + + return psgi_ok; + } }; + + my $test = Plack::Test->create($app); + + ok( + $test->request( GET '/mount/mounted_path' )->is_success, + 'Request successful', + ); +}; + +subtest 'Different method' => sub { + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + + is( $request->method, 'PUT', 'Correct method' ); + + is( + $request->env->{'REQUEST_METHOD'}, + $request->method, + 'REQUEST_METHOD derived from env', + ); + + return psgi_ok; + } ); + + ok( + $test->request( PUT '/' )->is_success, + 'Request successful', + ); +}; + +# the calling order to this method matters because it checks +# how many requests were run so far +subtest 'Checking request ID' => sub { + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + is( $request->id, 8, 'Correct request id' ); + + return psgi_ok; + } ); + + ok( + $test->request( GET '/' )->is_success, + 'Request successful', + ); +}; + +subtest 'is_$method (head/post/get/put/delete/patch' => sub { + foreach my $http_method ( qw<head post get put delete patch> ) { + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + my $method = "is_$http_method"; + ok( $request->$method, $method ); + return psgi_ok; + } ); + + ok( + $test->request( + HTTP::Request->new( ( uc $http_method ) => '/' ) + )->is_success, + 'Request successful', + ); + } +}; + +subtest 'Parameters (body/query/route)' => sub { + note $Dancer2::Core::Request::XS_URL_DECODE ? + 'Running test with XS_URL_DECODE' : + 'Running test without XS_URL_DECODE'; + + note $Dancer2::Core::Request::XS_PARSE_QUERY_STRING ? + 'Running test with XS_PARSE_QUERY_STRING' : + 'Running test without XS_PARSE_QUERY_STRING'; + + test_all_params; + + if ( $Dancer2::Core::Request::XS_PARSE_QUERY_STRING ) { + note 'Running test without XS_PARSE_QUERY_STRING'; + $Dancer2::Core::Request::XS_PARSE_QUERY_STRING = 0; + test_all_params; + } + + if ( $Dancer2::Core::Request::XS_URL_DECODE ) { + note 'Running test without XS_URL_DECODE'; + $Dancer2::Core::Request::XS_URL_DECODE = 0; + test_all_params; + } +}; + +# multiple parsing of request body (such as from creating two request objects) +# previously caused an infinite loop when HTTP::Body was used. +subtest 'Multiple request object creation doesnt reparse request body' => sub { + my $test = Plack::Test->create( sub { + my $env = shift; + my $request = Dancer2::Core::Request->new( env => $env ); + # Second institation shouldn't reparse request body. + my $request2 = Dancer2::Core::Request->new( env => $env ); + + my %exp_params = ( + post => { + x => 1, meth => 'post', + }, + ); + + is( $request->path, '/', 'path is set' ); + is( $request->method, 'POST', 'method is set' ); + + is_deeply( + scalar( $request->params('body') ), + $exp_params{'post'}, + 'body params are OK', + ); + + return psgi_ok; + } ); + + my $req = POST '/', { x => 1, meth => 'post' }; + + ok( + $test->request($req)->is_success, + 'Request successful', + ); +}; + +# more stuff to test + +# special methods: +# forwarded_for_address +# forwarded_protocol +# forwarded_host +# host + +#subtest 'Behind proxy (host/is_behind_proxy)' => sub { +# my $test = Plack::Test->create( sub { psgi_ok } ); +# +# ok( +# $test->request( GET '/dev/null' )->is_success, +# 'Different method request successful', +# ); +#}; + +#subtest 'Path resolution methods' => sub { +# my $test = Plack::Test->create( sub { +# my $env = shift; +# my $request = Dancer2::Core::Request->new( env => $env ); +# +# return psgi_ok; +# } ); +#}; + +#subtest 'Upload' => sub {1}; +#subtest 'Scheme' => sub {1}; +#subtest 'Cookies' => sub {1}; +#subtest 'Headers' => sub {1}; diff --git a/t/classes/Dancer2-Core-Request/serializers.t b/t/classes/Dancer2-Core-Request/serializers.t new file mode 100644 index 00000000..02591bc2 --- /dev/null +++ b/t/classes/Dancer2-Core-Request/serializers.t @@ -0,0 +1,74 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App::CBOR; ## no critic + use Dancer2; + + # postpone + sub setup { + set serializer => 'CBOR'; + post '/' => sub { + ::is_deeply( +{ params() }, +{}, 'Empty parameters' ); + ::is( request->data, 'Foo', 'Correct data using request->data' ); + return 'ok'; + }; + } +} + +subtest 'Testing with CBOR' => sub { + eval { require CBOR::XS; 1; } + or plan skip_all => 'CBOR::XS is needed for this test'; + + eval { require Dancer2::Serializer::CBOR; 1; } + or plan skip_all => 'Dancer2::Serializer::CBOR is needed for this test'; + + App::CBOR->setup; + my $app = Plack::Test->create( App::CBOR->to_app ); + my $res = $app->request( + POST '/', + Content => CBOR::XS::encode_cbor('Foo'), + ); + + ok( $res->is_success, 'Successful response' ); + is( + $res->content, + CBOR::XS::encode_cbor('ok'), + 'Correct response', + ); +}; + +{ + package App::JSON; ## no critic + use Dancer2; + set serializer => 'JSON'; + post '/' => sub { + ::is_deeply( +{ params() }, +{}, 'Empty parameters' ); + ::is_deeply( + request->data, + [ qw<foo bar> ], + 'Correct data using request->data', + ); + return [ qw<foo bar> ]; + }; +} + +subtest 'Testing with JSON' => sub { + my $app = Plack::Test->create( App::JSON->to_app ); + my $res = $app->request( + POST '/', + Content => '["foo","bar"]', + ); + + ok( $res->is_success, 'Successful response' ); + is( + $res->content, + '["foo","bar"]', + 'Correct response', + ); +}; + +done_testing(); diff --git a/t/classes/Dancer2-Core-Response-Delayed/after_hooks.t b/t/classes/Dancer2-Core-Response-Delayed/after_hooks.t new file mode 100644 index 00000000..a13c7f05 --- /dev/null +++ b/t/classes/Dancer2-Core-Response-Delayed/after_hooks.t @@ -0,0 +1,64 @@ +use strict; +use warnings; +use Test::More; + +use Plack::Test; +use HTTP::Request::Common; +use HTTP::Cookies; + +# Tests to ensure a delayed ( but not async ) response +# still have "after" hooks called, such as for session flushing + +{ + package App::Delayed; + use Dancer2; + + set session => 'Simple', + + get '/' => sub { + session file => __FILE__; + open my $fh, "<", __FILE__; + delayed { + my $responder = $Dancer2::Core::Route::RESPONDER; + my $res = $Dancer2::Core::Route::RESPONSE; + return $responder->( + [ $res->status, $res->headers_to_array, $fh ] + ); + }; + }; + + get '/file' => sub { + session 'file'; + }; + +} + +my $jar = HTTP::Cookies->new(); +my $base = 'http://localhost'; + +my $test = Plack::Test->create( App::Delayed->to_app ); + +subtest "delayed (not async) response" => sub { + my $res = $test->request( GET "$base/" ); + $jar->extract_cookies($res); + + ok $res->is_success, 'Successful request for /'; + + open my $fh, "<:raw", __FILE__; + my $content = do { local $/; <$fh> }; + is $res->content, $content, "response returned test file content"; +}; + +subtest "after hook flushes session headers for delayed response" => sub { + my $req = GET("$base/file"); + $jar->add_cookie_header($req); + + my $res = $test->request($req); + $jar->extract_cookies($res); + + ok $res->is_success, 'Successful request for /file'; + is $res->content, __FILE__, "Session returned test file name"; +}; + +done_testing(); + diff --git a/t/classes/Dancer2-Core-Response-Delayed/new.t b/t/classes/Dancer2-Core-Response-Delayed/new.t new file mode 100644 index 00000000..3eaa93a7 --- /dev/null +++ b/t/classes/Dancer2-Core-Response-Delayed/new.t @@ -0,0 +1,70 @@ +use strict; +use warnings; +use Test::More tests => 18; +use Dancer2::Core::Runner; +use Dancer2::Core::Request; +use Dancer2::Core::Response; + +use_ok('Dancer2::Core::Response::Delayed'); + +my $runner = Dancer2::Core::Runner->new; +isa_ok( $runner, 'Dancer2::Core::Runner' ); +$Dancer2::runner = $runner; + +my $request = Dancer2::Core::Request->new( + env => { PATH_INFO => '/foo' }, +); +isa_ok( $request, 'Dancer2::Core::Request' ); + +my $response = Dancer2::Core::Response->new(); +isa_ok( $response, 'Dancer2::Core::Response' ); + +my $test = 0; +my $del_res = Dancer2::Core::Response::Delayed->new( + request => $request, + response => $response, + cb => sub { + ::isa_ok( + $Dancer2::Core::Route::REQUEST, + 'Dancer2::Core::Request', + ); + + ::isa_ok( + $Dancer2::Core::Route::RESPONSE, + 'Dancer2::Core::Response', + ); + + ::is( + $Dancer2::Core::Route::REQUEST->path, + '/foo', + 'Correct path in the request', + ); + + ::isa_ok( + $Dancer2::Core::Route::RESPONDER, + 'CODE', + 'Got a responder callback', + ); + + $test++; + + $Dancer2::Core::Route::RESPONDER->('OK'); + }, +); + +isa_ok( $del_res, 'Dancer2::Core::Response::Delayed' ); +can_ok( $del_res, qw<request response cb> ); +can_ok( $del_res, qw<is_halted has_passed to_psgi> ); + +is( $del_res->is_halted, 0, 'is_halted returns no' ); +is( $del_res->has_passed, 0, 'has_passed returns no' ); + +my $res_cb = sub { is( $_[0], 'OK', 'Correct response asynchronously' ) }; + +my $psgi_res = $del_res->to_psgi(); +is( $test, 0, 'Callback not run yet' ); +$psgi_res->($res_cb); +is( $test, 1, 'Callback run' ); + +is $del_res->status => 200, "we can access the response header"; +isa_ok( $del_res->headers, "HTTP::Headers", "Able to retrieve headers"); diff --git a/t/classes/Dancer2-Core-Response/new_from.t b/t/classes/Dancer2-Core-Response/new_from.t new file mode 100644 index 00000000..14cc8cbb --- /dev/null +++ b/t/classes/Dancer2-Core-Response/new_from.t @@ -0,0 +1,71 @@ +use strict; +use warnings; +use Test::More tests => 3; +use Plack::Response; +use Dancer2::Core::Response; + +sub normalize_headers { + my $headers = shift; + + my %headers = (); + while ( my ( $key, $val ) = splice @{$headers}, 0, 2 ) { + $headers{$key} = $val; + } + + return %headers; +} + +can_ok( Dancer2::Core::Response::, qw<new_from_array new_from_plack> ); + +my %default_headers = ( + 'Content-Type' => 'text/plain', + 'X-Test' => 'Val', +); + +subtest 'new_from_array' => sub { + plan tests => 4; + + my $array = [ 200, [%default_headers], ['Foo'] ]; + my $response = Dancer2::Core::Response->new_from_array($array); + + isa_ok( $response, 'Dancer2::Core::Response' ); + is( $response->status, 200, 'Correct status' ); + is( $response->content, 'Foo', 'Correct content' ); + + # hash randomization + my %headers = normalize_headers( $response->headers_to_array ); + + is_deeply( + \%headers, + \%default_headers, + 'All headers correct', + ); +}; + +subtest 'new_from_plack' => sub { + plan tests => 5; + + my $plack = Plack::Response->new(); + isa_ok( $plack, 'Plack::Response' ); + + $plack->status(200); + $plack->body('Bar'); + foreach my $header_name ( keys %default_headers ) { + $plack->header( $header_name => $default_headers{$header_name} ); + } + + my $response = Dancer2::Core::Response->new_from_plack($plack); + isa_ok( $response, 'Dancer2::Core::Response' ); + is( $response->status, 200, 'Correct status' ); + is( $response->content, 'Bar', 'Correct content' ); + + # hash randomization + my %headers = normalize_headers( $response->headers_to_array ); + + is_deeply( + \%headers, + \%default_headers, + 'All headers correct', + ); +}; + diff --git a/t/classes/Dancer2-Core-Role-Engine/with.t b/t/classes/Dancer2-Core-Role-Engine/with.t new file mode 100644 index 00000000..2ad3281d --- /dev/null +++ b/t/classes/Dancer2-Core-Role-Engine/with.t @@ -0,0 +1,21 @@ +use strict; +use warnings; +use Test::More tests => 4; + +{ + package App; + use Moo; + with 'Dancer2::Core::Role::Engine'; + sub hook_aliases { +{} } + sub supported_hooks {} +} + +my $app = App->new; +isa_ok( $app, 'App' ); +can_ok( $app, qw<session config> ); # attributes +can_ok( $app, qw<set_session clear_session has_session> ); # methods +ok( + $app->DOES('Dancer2::Core::Role::Hookable'), + 'App consumes Dancer2::Core::Role::Hookable', +); + diff --git a/t/classes/Dancer2-Core-Role-Handler/with.t b/t/classes/Dancer2-Core-Role-Handler/with.t new file mode 100644 index 00000000..b1905497 --- /dev/null +++ b/t/classes/Dancer2-Core-Role-Handler/with.t @@ -0,0 +1,19 @@ +use strict; +use warnings; +use Test::More tests => 3; + +{ + package Handler; + use Moo; + with 'Dancer2::Core::Role::Handler'; + sub register {} +} + +my $handler = Handler->new; +isa_ok( $handler, 'Handler' ); +can_ok( $handler, qw<app> ); # attributes +ok( + $handler->DOES('Dancer2::Core::Role::Handler'), + 'Handler consumes Dancer2::Core::Role::Handler', +); + diff --git a/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/bin/.exists b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/bin/.exists new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/bin/.exists diff --git a/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/lib/fake/inner/dir/.exists b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/lib/fake/inner/dir/.exists new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerDir/lib/fake/inner/dir/.exists diff --git a/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/.dancer b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/.dancer new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/.dancer diff --git a/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/fakescript.pl b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/fakescript.pl new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/t/classes/Dancer2-Core-Role-HasLocation/FakeDancerFile/fakescript.pl diff --git a/t/classes/Dancer2-Core-Role-HasLocation/with.t b/t/classes/Dancer2-Core-Role-HasLocation/with.t new file mode 100644 index 00000000..ab80b84b --- /dev/null +++ b/t/classes/Dancer2-Core-Role-HasLocation/with.t @@ -0,0 +1,105 @@ +use strict; +use warnings; +use File::Spec; +use File::Basename; +use Test::More tests => 11; + +{ + package App; + use Moo; + with 'Dancer2::Core::Role::HasLocation'; +} + +note 'Defaults:'; { + my $app = App->new(); + isa_ok( $app, 'App' ); + can_ok( $app, qw<caller location> ); # attributes + can_ok( $app, '_build_location' ); # methods + + ok( + $app->DOES('Dancer2::Core::Role::HasLocation'), + 'App consumes Dancer2::Core::Role::HasLocation', + ); + + my $path = File::Spec->catfile(qw< + t classes Dancer2-Core-Role-HasLocation with.t + >); + + is( + File::Spec->canonpath( $app->caller ), + $path, + 'Default caller', + ); + +} + +my $basedir = dirname( File::Spec->rel2abs(__FILE__) ); + +note 'With lib/ and bin/:'; { + my $app = App->new( + caller => File::Spec->catfile( + $basedir, qw<FakeDancerDir fake inner dir fakescript.pl> + ) + ); + + isa_ok( $app, 'App' ); + + my $location = $app->location; + $location =~ s/\/$//; + + my $path = File::Spec->rel2abs( + File::Spec->catdir( + File::Spec->curdir, + qw<t classes Dancer2-Core-Role-HasLocation FakeDancerDir>, + ) + ); + + is( + $location, + $path, + 'Got correct location with lib/ and bin/', + ); +} + +note 'With .dancer file:'; { + my $app = App->new( + caller => File::Spec->catfile( + $basedir, qw<FakeDancerFile script.pl> + ) + ); + + isa_ok( $app, 'App' ); + + my $location = $app->location; + + my $path = File::Spec->rel2abs( + File::Spec->catdir( + File::Spec->curdir, + qw<t classes Dancer2-Core-Role-HasLocation FakeDancerFile>, + ) + ); + + is( $location, $path, 'Got correct location with .dancer file' ); +} + +note 'blib/ ignored:'; { + my $app = App->new( + caller => File::Spec->catfile( + $basedir, qw<FakeDancerDir blib lib fakescript.pl> + ) + ); + + isa_ok( $app, 'App' ); + + my $location = $app->location; + $location =~ s/\/$//; + + my $path = File::Spec->rel2abs( + File::Spec->catdir( + File::Spec->curdir, + qw<t classes Dancer2-Core-Role-HasLocation FakeDancerDir>, + ) + ); + + is( $location, $path, 'blib/ dir is ignored' ); +} diff --git a/t/classes/Dancer2-Core-Role-Serializer/with.t b/t/classes/Dancer2-Core-Role-Serializer/with.t new file mode 100644 index 00000000..4524079d --- /dev/null +++ b/t/classes/Dancer2-Core-Role-Serializer/with.t @@ -0,0 +1,164 @@ +use strict; +use warnings; +use Test::More tests => 4; +use Test::Fatal; + +use_ok('Dancer2::Core::Hook'); + +{ + package Serializer::OK; + use Moo; + with 'Dancer2::Core::Role::Serializer'; + has '+content_type' => ( default => sub {'plain/test'} ); + + sub serialize {'{'.$_[1].'}'} + sub deserialize {'['.$_[1].']'} +} + +subtest 'Successful' => sub { + plan tests => 5; + + my $srl = Serializer::OK->new; + isa_ok( $srl, 'Serializer::OK' ); + + $srl->add_hook( + Dancer2::Core::Hook->new( + name => 'engine.serializer.before', + code => sub { + my $content = shift; + ::is( $content, 'foo', 'Correct content in before hook' ); + }, + ) + ); + + $srl->add_hook( + Dancer2::Core::Hook->new( + name => 'engine.serializer.after', + code => sub { + my $content = shift; + ::is( $content, '{foo}', 'Correct content in after hook' ); + }, + ) + ); + + is( $srl->serialize('foo'), '{foo}', 'Serializing' ); + is( $srl->deserialize('bar'), '[bar]', 'Deserializing' ); +}; + +{ + package Serializer::NotOK; + use Moo; + with 'Dancer2::Core::Role::Serializer'; + has '+content_type' => ( default => sub {'plain/test'} ); + + sub serialize { die '+' . $_[1] . '+' } + sub deserialize { die '-' . $_[1] . '-' } +} + +subtest 'Unsuccessful' => sub { + plan tests => 21; + + use_ok('Dancer2::Logger::Capture'); + + { + my $logger = Dancer2::Logger::Capture->new; + isa_ok( $logger, 'Dancer2::Logger::Capture' ); + + my $srl = Serializer::NotOK->new( + log_cb => sub { $logger->log(@_) } + ); + + isa_ok( $srl, 'Serializer::NotOK' ); + is( $srl->serialize('foo'), undef, 'Serialization result' ); + + my $trap = $logger->trapper; + isa_ok( $trap, 'Dancer2::Logger::Capture::Trap' ); + + my $errors = $trap->read; + isa_ok( $errors, 'ARRAY' ); + is( scalar @{$errors}, 1, 'One error caught' ); + + my $msg = $errors->[0]; + isa_ok( $msg, 'HASH' ); + is( scalar keys %{$msg}, 3, 'Two items in the error' ); + + is( $msg->{'level'}, 'core', 'Correct level' ); + like( + $msg->{'message'}, + qr{^Failed to serialize content: \+foo\+}, + 'Correct error message', + ); + } + + { + my $logger = Dancer2::Logger::Capture->new; + isa_ok( $logger, 'Dancer2::Logger::Capture' ); + + my $srl = Serializer::NotOK->new( + log_cb => sub { $logger->log(@_) } + ); + + isa_ok( $srl, 'Serializer::NotOK' ); + is( $srl->deserialize('bar'), undef, 'Deserialization result' ); + + my $trap = $logger->trapper; + isa_ok( $trap, 'Dancer2::Logger::Capture::Trap' ); + + my $errors = $trap->read; + isa_ok( $errors, 'ARRAY' ); + is( scalar @{$errors}, 1, 'One error caught' ); + + my $msg = $errors->[0]; + isa_ok( $msg, 'HASH' ); + is( scalar keys %{$msg}, 3, 'Two items in the error' ); + + is( $msg->{'level'}, 'core', 'Correct level' ); + like( + $msg->{'message'}, + qr{^Failed to deserialize content: \-bar\-}, + 'Correct error message', + ); + } +}; + +{ + package Serializer::Empty; + use Moo; + with 'Dancer2::Core::Role::Serializer'; + has '+content_type' => ( default => 'plain/test' ); + sub serialize {'BAD SERIALIZE'} + sub deserialize {'BAD DESERIALIZE'} +} + +subtest 'Called with empty content' => sub { + plan tests => 6; + + my $srl = Serializer::Empty->new; + isa_ok( $srl, 'Serializer::Empty' ); + can_ok( $srl, qw<serialize deserialize> ); + + is( + $srl->serialize(), + undef, + 'Do not try to serialize without input', + ); + + is( + $srl->serialize(''), + '', + 'Do not try to serialize with empty input', + ); + + is( + $srl->deserialize(), + undef, + 'Do not try to deserialize without input', + ); + + is( + $srl->deserialize(''), + '', + 'Do not try to deserialize with empty input', + ); +} + diff --git a/t/classes/Dancer2-Core-Role-StandardResponses/with.t b/t/classes/Dancer2-Core-Role-StandardResponses/with.t new file mode 100644 index 00000000..4bba4e56 --- /dev/null +++ b/t/classes/Dancer2-Core-Role-StandardResponses/with.t @@ -0,0 +1,120 @@ +use strict; +use warnings; +use Test::More tests => 24; + +{ + package Handler; + use Moo; + with 'Dancer2::Core::Role::StandardResponses'; +} + +{ + package App; + use Moo; + has response => ( is => 'ro', default => sub { Response->new } ); +} + +{ + package Response; + use Moo; + has status => (is => 'ro', reader => '_status'); + has header => (is => 'ro', reader => '_header'); + sub status { shift->_status->(@_) } + sub header { shift->_header->(@_) } +} + +note 'Checking our fake app'; { + my $app = App->new; + isa_ok( $app, 'App' ); + can_ok( $app, 'response' ); + isa_ok( $app->response, 'Response' ); +} + +note 'Checking our fake response'; { + my $response = Response->new( + status => sub { + my ( $self, $input ) = @_; + ::isa_ok( $self, 'Response' ); + ::is( $input, 'calling status', 'status called' ); + return 'foo'; + }, + + header => sub { + my ( $self, $input ) = @_; + ::isa_ok( $self, 'Response' ); + ::is( $input, 'calling header', 'header called' ); + return qw<bar baz>; + }, + ); + + isa_ok( $response, 'Response' ); + + is_deeply( + [ $response->status('calling status') ], + [ 'foo' ], + 'status() works', + ); + + is_deeply( + [ $response->header('calling header') ], + [ qw<bar baz> ], + 'header() works', + ); +} + +my $handler = Handler->new; +isa_ok( $handler, 'Handler' ); +can_ok( $handler, qw<response standard_response> ); + +note '->response'; { + # set up status and header + my $app = App->new( + response => Response->new( + status => sub { + my ( $self, $code ) = @_; + ::isa_ok( $self, 'Response' ); + ::is( $code, '400', 'Correct status code' ); + }, + + header => sub { + my ( $self, $hdr_name, $hdr_content ) = @_; + ::isa_ok( $self, 'Response' ); + ::is( $hdr_name, 'Content-Type', 'Correct header name' ); + ::is( $hdr_content, 'text/plain', 'Correct header value' ); + }, + ) + ); + + is( + $handler->response( $app, 400, 'Some Message' ), + 'Some Message', + 'Correct response created', + ); +} + +note '->standard_response'; { + # set up status and header + my $app = App->new( + response => Response->new( + status => sub { + my ( $self, $code ) = @_; + ::isa_ok( $self, 'Response' ); + ::is( $code, '400', 'Correct status code' ); + }, + + header => sub { + my ( $self, $hdr_name, $hdr_content ) = @_; + ::isa_ok( $self, 'Response' ); + ::is( $hdr_name, 'Content-Type', 'Correct header name' ); + ::is( $hdr_content, 'text/plain', 'Correct header value' ); + }, + ) + ); + + is( + $handler->standard_response( $app, 400 ), + 'Bad Request', + 'Correct response 400 created', + ); +} + diff --git a/t/classes/Dancer2-Core-Route/base.t b/t/classes/Dancer2-Core-Route/base.t new file mode 100644 index 00000000..223ba6ae --- /dev/null +++ b/t/classes/Dancer2-Core-Route/base.t @@ -0,0 +1,67 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Dancer2::Core::Route; + +plan tests => 3; + +my @no_leading_slash = ( 'no+leading+slash', '' ); +my @leading_slash = ('/+leading+slash', '/', '//' ); + +subtest "no prefix, paths without a leading slash" => sub { + for my $string ( @no_leading_slash ) { + my $route; + my $exception = exception { + $route = Dancer2::Core::Route->new( + regexp => $string, + method => 'get', + code => sub {1}, + ); + }; + is( $exception, undef, + "'$string' is a valid route pattern" + ); + is( $route->spec_route, "/$string", + "undef prefix prepends '/' to spec_route" + ); + } +}; + +subtest "no prefix, paths with a leading slash" => sub { + for my $string ( @leading_slash ) { + my $route; + my $exception = exception { + $route = Dancer2::Core::Route->new( + regexp => $string, + method => 'get', + code => sub {1}, + ); + }; + is( $exception, undef, + "'$string' is a valid route pattern" + ); + is( $route->spec_route, $string, + "undef prefix does not prepend '/' to spec_route" + ); + } +}; + +subtest "prefix and paths append" => sub { + my $prefix = '/prefix'; + for my $string ( @no_leading_slash, @leading_slash) { + my $route; + my $exception = exception { + $route = Dancer2::Core::Route->new( + regexp => $string, + prefix => $prefix, + method => 'get', + code => sub {1}, + ); + }; + is( $exception, undef, + "'$prefix$string' is a valid route pattern" + ); + } +}; + diff --git a/t/classes/Dancer2-Core-Route/deprecated_param_keys.t b/t/classes/Dancer2-Core-Route/deprecated_param_keys.t new file mode 100644 index 00000000..33c8a879 --- /dev/null +++ b/t/classes/Dancer2-Core-Route/deprecated_param_keys.t @@ -0,0 +1,34 @@ +use strict; +use warnings; +use Test::More; +use Capture::Tiny 0.12 'capture_stderr'; +BEGIN { use_ok('Dancer2::Core::Route') } + +like( + capture_stderr { + Dancer2::Core::Route->new( + regexp => '/:splat', + code => sub {1}, + method => 'get', + ); + }, + qr{^Named placeholder 'splat' is deprecated}, + 'Find deprecation of :splat', +); + +SKIP: { + skip 'Need perl >= 5.10', 1 unless $] >= 5.010; + like( + capture_stderr { + Dancer2::Core::Route->new( + regexp => '/:captures', + code => sub {1}, + method => 'get', + ); + }, + qr{^Named placeholder 'captures' is deprecated}, + 'Find deprecation of :captures', + ); +} + +done_testing; diff --git a/t/classes/Dancer2-Core-Route/match.t b/t/classes/Dancer2-Core-Route/match.t new file mode 100644 index 00000000..26520a8e --- /dev/null +++ b/t/classes/Dancer2-Core-Route/match.t @@ -0,0 +1,437 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Dancer2::Core::Request; +use Dancer2::Core::Route; +use Capture::Tiny 0.12 'capture_stderr'; +use Ref::Util qw<is_regexpref>; +use lib 't/lib'; + +my @tests = ( + [ [ 'get', '/', sub {11} ], '/', [ {}, 11 ] ], + [ [ 'get', '/', sub {11} ], + '/failure', + [ undef, 11 ] + ], + + # token tests + [ [ 'get', '/hello/:name', sub {22} ], + '/hello/sukria', + [ { name => 'sukria' }, 22 ] + ], + [ [ 'get', '/hello/:name?', sub {22} ], + '/hello/', + [ { name => undef }, 22 ] + ], + + # prefix tests + [ [ 'get', '/', sub {33}, '/forum' ], + '/forum/', + [ {}, 33 ] + ], + [ [ 'get', '/', sub {33}, '/forum' ], + '/forum/', + [ {}, 33 ] + ], + [ [ 'get', '/mywebsite', sub {33}, '/forum' ], + '/forum/mywebsite', + [ {}, 33 ] + ], + [ [ 'get', '', sub {'concat'}, '/' ], + '/', + [ {}, 'concat' ] + ], + + # token in prefix tests + [ [ 'get', 'name', sub {35}, '/hello/:' ], + '/hello/sukria', + [ { name => 'sukria' }, 35 ], + ], + + [ [ 'get', '/', sub {36}, '/hello/:name' ], + '/hello/sukria/', + [ { name => 'sukria' }, 36 ], + ], + + # splat test + [ [ 'get', '/file/*.*', sub {44} ], + '/file/dist.ini', + [ { splat => [ 'dist', 'ini' ] }, 44 ] + ], + + # splat in prefix + [ [ 'get', '', sub {42}, '/forum/*'], + '/forum/dancer', + [ { splat => [ 'dancer' ] }, 42 ] + ], + + # megasplat test + [ [ 'get', '/file/**/*', sub {44} ], + '/file/some/where/42', + [ { splat => [ [ 'some', 'where' ], '42' ] }, 44 ] + ], + + # megasplat consistently handles multiple slashes + [ [ 'get', '/foo/**', sub {'45a'} ], + '/foo/bar///baz', + [ { splat => [ [ 'bar', '', '', 'baz' ] ] }, '45a' ] + ], + [ [ 'get', '/foo/**', sub {'45b'} ], + '/foo/bar///', # empty trailing path segment + [ { splat => [ [ 'bar', '', '', '' ] ] }, '45b' ] + ], + + # Optional megasplat test - with a value... + [ [ 'get', '/foo/?**?', sub {46} ], + '/foo/bar/baz', + [ { splat => [ [ 'bar', 'baz' ] ] }, 46 ], + ], + # ... and without + [ [ 'get', '/foo/?**?', sub {47} ], + '/foo', + [ { splat => [ [ ] ] }, 47 ], + ], + + # mixed (mega)splat and tokens + [ [ 'get', '/some/:id/**/*', sub {55} ], + '/some/where/to/run/and/hide', + [ { id => 'where', splat => [ [ 'to', 'run', 'and' ], 'hide' ] }, 55 ] + ], + [ [ 'get', '/some/*/**/:id?', sub {55} ], + '/some/one/to/say/boo/', + [ { id => undef, splat => [ 'one', [ 'to', 'say', 'boo' ] ] }, 55 ] + ], + + # supplied regex + [ [ 'get', qr{stuff(\d+)}, sub {44} ], '/stuff48', + [ { splat => [48] }, 44 ] + ], + [ [ 'get', qr{/stuff(\d+)}, sub {44}, '/foo' ], + '/foo/stuff48', + [ { splat => [48] }, 44 ], + ], + +); + + +plan tests => 111; + +for my $t (@tests) { + my ( $route, $path, $expected ) = @$t; + + if ( is_regexpref($expected) ) { + like( + exception { + my $r = Dancer2::Core::Route->new( + method => $route->[0], + regexp => $route->[1], + code => $route->[2], + prefix => $route->[3], + ); + }, + $expected, + "got expected exception for $path", + ); + } + else { + my $r = Dancer2::Core::Route->new( + method => $route->[0], + regexp => $route->[1], + code => $route->[2], + prefix => $route->[3], + ); + isa_ok $r, 'Dancer2::Core::Route'; + + my $request = Dancer2::Core::Request->new( + env => { + PATH_INFO => $path, + REQUEST_METHOD => $route->[0], + } + ); + my $m; + is( capture_stderr { $m = $r->match($request) }, '', + "no warnings generated for $path" ); + is_deeply $m, $expected->[0], "got expected data for '$path'"; + + { + package App; use Dancer2; ## no critic + } + + use Dancer2::Core::App; + use Dancer2::Core::Response; + my $app = Dancer2::Core::App->new( + request => $request, + response => Dancer2::Core::Response->new, + ); + + is $r->execute($app)->content, $expected->[1], "got expected result for '$path'"; + + # failing request + my $failing_request = Dancer2::Core::Request->new( + env => { + PATH_INFO => '/something_that_doesnt_exist', + REQUEST_METHOD => 'GET', + }, + ); + + $m = $r->match($failing_request); + is $m, undef, "don't match failing request"; + } +} + +# captures test +SKIP: { + skip "Need perl >= 5.10", 1 unless $] >= 5.010; + + ## Regexp is parsed in compile time. So, eval with QUOTES to force to parse later. + my $route_regex; + + ## no critic + + eval q{ + $route_regex = qr{/(?<class> user | content | post )/(?<action> delete | find )/(?<id> \d+ )}x; + }; + + ## use critic + + my $r = Dancer2::Core::Route->new( + regexp => $route_regex, + code => sub { + 'ok'; + }, + method => 'get', + ); + + my $request = Dancer2::Core::Request->new( + env => { + PATH_INFO => '/user/delete/234', + REQUEST_METHOD => 'GET', + }, + ); + + my $m = $r->match($request); + + is_deeply $m, + { captures => { + class => 'user', + action => 'delete', + id => 234 + } + }, + "named captures work"; +} + +note "routes with options"; { + my $route_w_options = Dancer2::Core::Route->new( + method => 'get', + regexp => '/', + code => sub {'options'}, + options => { 'agent' => 'cURL' }, + ); + + my $req = Dancer2::Core::Request->new( + path => '/', + method => 'get', + env => { 'HTTP_USER_AGENT' => 'mozilla' }, + ); + + my $m = $route_w_options->match($req); + ok !defined $m, 'Route did not match'; + + $req = Dancer2::Core::Request->new( + path => '/', + method => 'get', + env => { 'HTTP_USER_AGENT' => 'cURL' }, + ); + + $m = $route_w_options->match($req); + ok defined $m, 'Route matched'; + + $route_w_options = Dancer2::Core::Route->new( + method => 'get', + regexp => '/', + code => sub {'options'}, + options => { + 'agent' => 'cURL', + 'content_type' => 'foo', + }, + ); + + $req = Dancer2::Core::Request->new( + path => '/', + method => 'get', + env => { 'HTTP_USER_AGENT' => 'cURL' }, + ); + + # Check match more than once (each iterator wasn't reset, for loop is ok ) + $m = $route_w_options->match($req); + ok !defined $m, 'More options - Route did not match - test 1'; + $m = $route_w_options->match($req); + ok !defined $m, 'More options - Route did not match - test 2'; +} + +subtest "typed route params" => sub { + my @tests = ( + { + name => "good type check", + route => { + regexp => '/some/:id[Int]', + }, + request => '/some/34', + match => { id => 34 }, + }, + { + name => "bad required type check", + route => { + regexp => '/some/:id[Int]', + }, + request => '/some/bad', + }, + { + name => "missing required type check", + route => { + regexp => '/some/:id[Int]', + }, + request => '/some/', + }, + { + name => "optional type check exists", + route => { + regexp => '/some/:id[Int]?', + }, + request => '/some/34', + match => { id => 34 }, + }, + { + name => "optional type check with bad token", + route => { + regexp => '/some/:id[Int]?', + }, + request => '/some/bad', + }, + { + name => "optional type check with empty token", + route => { + regexp => '/some/:id[Int]?', + }, + request => '/some/', + match => { id => undef }, + }, + { + name => "optional type check with empty token and optional missing trailing slash", + route => { + regexp => '/some/?:id[Int]?', + }, + request => '/some', + match => { id => undef }, + }, + { + name => "bad type", + route => { + regexp => '/some/:id[MyDate]?', + exception => qr/MyDate is not a known type constraint/, + }, + request => '/some/foo', + match => { id => undef }, + }, + { + name => "custom type with good match", + route => { + regexp => '/date/:date[MyDate]', + args => { type_library => 'TestTypeLibrary' }, + }, + request => '/date/2014-01-01', + match => { date => '2014-01-01' }, + }, + { + name => "custom type with bad match", + route => { + regexp => '/date/:date[MyDate]', + args => { type_library => 'TestTypeLibrary' }, + }, + request => '/date/X014-01-01', + }, + { + name => "type including type library but no type_library config setting", + route => { + regexp => '/date/:date[TestTypeLibrary::MyDate]', + }, + request => '/date/2014-01-01', + match => { date => '2014-01-01' }, + }, + { + name => "union of types", + route => { + regexp => '/date/:date[Int|TestTypeLibrary::MyDate]', + }, + request => '/date/2014-01-01', + match => { date => '2014-01-01' }, + }, + { + name => "union of types checking other type", + route => { + regexp => '/date/:date[Int|TestTypeLibrary::MyDate]', + }, + request => '/date/2014', + match => { date => '2014' }, + }, + { + name => "multiple typed tokens plus other tokens and splats", + route => { + regexp => '/:id[Int]/:date[MyDate]/:foo/*/**', + args => { type_library => 'TestTypeLibrary' }, + }, + request => '/42/2018-11-23/bar/dave/was/here', + match => { + id => 42, + date => '2018-11-23', + foo => 'bar', + splat => [ 'dave', [ 'was', 'here' ] ], + }, + }, + ); + + for my $test (@tests) { + my $method = $test->{route}{method} || 'get'; + + my %route_args = ( + method => $method, + regexp => $test->{route}{regexp}, + code => $test->{route}{code} || sub { 'OK' }, + $test->{route}{prefix} ? ( prefix => $test->{route}{prefix} ) : (), + $test->{route}{args} ? %{ $test->{route}{args} } : (), + ); + + if ( my $exception = $test->{route}{exception} ) { + like exception { Dancer2::Core::Route->new(%route_args) }, + $exception, + "'$test->{name}' throws expected exception in route constructor"; + next; + } + + my $route = Dancer2::Core::Route->new(%route_args); + my $request = Dancer2::Core::Request->new( + env => { + PATH_INFO => $test->{request}, + REQUEST_METHOD => $method, + } + ); + + my $match; + is exception { + $match = $route->match($request) + }, undef, "'$test->{name}' does not throw an exception"; + + my $expected = $test->{match}; + if ( defined $expected ) { + is_deeply $match, $expected, + "... and route matched with expected captures" + or diag explain $match; + } + else { + ok !defined $match, "... and route did not match" + or diag explain $match; + } + } +}; diff --git a/t/classes/Dancer2-Core-Runner/environment.t b/t/classes/Dancer2-Core-Runner/environment.t new file mode 100644 index 00000000..9406c3d9 --- /dev/null +++ b/t/classes/Dancer2-Core-Runner/environment.t @@ -0,0 +1,42 @@ +use strict; +use warnings; +use Test::More tests => 6; +use Dancer2::Core::Runner; + +# undefine ENV vars used as defaults for app environment in these tests +local $ENV{DANCER_ENVIRONMENT}; +local $ENV{PLACK_ENV}; + +{ + my $runner = Dancer2::Core::Runner->new(); + isa_ok( $runner, 'Dancer2::Core::Runner' ); + + is( + $runner->environment, + 'development', + 'Default environment', + ); +} + +{ + local $ENV{DANCER_ENVIRONMENT} = 'foo'; + my $runner = Dancer2::Core::Runner->new(); + isa_ok( $runner, 'Dancer2::Core::Runner' ); + is( + $runner->environment, + 'foo', + 'Successfully set envinronment using DANCER_ENVIRONMENT', + ); +} + +{ + local $ENV{PLACK_ENV} = 'bar'; + my $runner = Dancer2::Core::Runner->new(); + isa_ok( $runner, 'Dancer2::Core::Runner' ); + is( + $runner->environment, + 'bar', + 'Successfully set environment using PLACK_ENV', + ); +} + diff --git a/t/classes/Dancer2-Core-Runner/new.t b/t/classes/Dancer2-Core-Runner/new.t new file mode 100644 index 00000000..215d69ad --- /dev/null +++ b/t/classes/Dancer2-Core-Runner/new.t @@ -0,0 +1,232 @@ +use strict; +use warnings; +use Test::More tests => 39; + +# undefine ENV vars used as defaults for app environment in these tests +local $ENV{DANCER_ENVIRONMENT}; +local $ENV{PLACK_ENV}; + +use_ok('Dancer2::Core::Runner'); + +is( $Dancer2::runner, undef, 'No runner defined in Dancer2 yet' ); + +{ + my $runner = Dancer2::Core::Runner->new(); + isa_ok( $runner, 'Dancer2::Core::Runner' ); +} + +note 'MIME types'; { + my $runner = Dancer2::Core::Runner->new(); + can_ok( $runner, 'mime_type' ); + isa_ok( $runner->mime_type, 'Dancer2::Core::MIME' ); +} + +ok( $Dancer2::runner, 'Have a runner (probably) in $Dancer2::runner' ); +isa_ok( $Dancer2::runner, 'Dancer2::Core::Runner', 'Runner now defined' ); + +note 'BUILD setting $Carp::Verbose'; +{ + my $runner = Dancer2::Core::Runner->new(); + is( $runner->config->{'traces'}, 0, 'traces not turned on (default' ); + is( $Carp::Verbose, 0, 'Carp Verbose not turned on (default)' ); +} + +{ + local $ENV{DANCER_TRACES} = 1; + my $runner = Dancer2::Core::Runner->new(); + is( $runner->config->{'traces'}, 1, 'traces turned on' ); + is( $Carp::Verbose, 1, 'Carp Verbose turned on (using DANCER_TRACES)' ); +} + +note 'server'; { + my $runner = Dancer2::Core::Runner->new( + host => '1.2.3.4', port => 9543, timeout => 3, + ); + can_ok( $runner, qw<server _build_server run> ); + + my $server = $runner->server; + isa_ok( $server, 'HTTP::Server::PSGI' ); + can_ok( $server, 'run' ); + foreach my $attr ( qw<host port timeout> ) { + is( $server->{$attr}, $runner->$attr, "$attr set correctly in Server" ); + } + + is( + $server->{'server_software'}, + "Perl Dancer2 " . Dancer2->VERSION, + 'server_software set correctly in Server', + ); +} + +note 'Environment'; +{ + my $runner = Dancer2::Core::Runner->new(); + + is( + $runner->environment, + 'development', + 'Default environment', + ); +} + +{ + local $ENV{DANCER_ENVIRONMENT} = 'foo'; + my $runner = Dancer2::Core::Runner->new(); + is( + $runner->environment, + 'foo', + 'Successfully set envinronment using DANCER_ENVIRONMENT', + ); + + $runner->config->{'apphandler'} = 'Standalone'; +} + +{ + local $ENV{PLACK_ENV} = 'bar'; + my $runner = Dancer2::Core::Runner->new(); + is( + $runner->environment, + 'bar', + 'Successfully set environment using PLACK_ENV', + ); + + is( + $runner->config->{'apphandler'}, + 'PSGI', + 'apphandler set to PSGI under PLACK_ENV', + ); +} + +{ + local $ENV{DANCER_APPHANDLER} = 'baz'; + my $runner = Dancer2::Core::Runner->new(); + is( + $runner->config->{'apphandler'}, + 'baz', + 'apphandler set via DANCER_APPHANDLER', + ); +} + +note 'Server tokens'; +{ + my $runner = Dancer2::Core::Runner->new(); + is( + $runner->config->{'no_server_tokens'}, + 0, + 'Default no_server_tokens', + ); +} + +{ + local $ENV{DANCER_NO_SERVER_TOKENS} = 1; + my $runner = Dancer2::Core::Runner->new(); + is( + $runner->config->{'no_server_tokens'}, + 1, + 'Successfully set no_server_tokens using DANCER_NO_SERVER_TOKENS', + ); +} + +note 'Startup info'; +{ + my $runner = Dancer2::Core::Runner->new(); + is( + $runner->config->{'startup_info'}, + 1, + 'Default startup_info', + ); +} + +{ + local $ENV{DANCER_STARTUP_INFO} = 0; + my $runner = Dancer2::Core::Runner->new(); + is( + $runner->config->{'startup_info'}, + 0, + 'Successfully set startup_info using DANCER_STARTUP_INFO', + ); +} + +{ + { + package App::Fake; + use Moo; + has name => ( + is => 'ro', + default => sub {__PACKAGE__}, + ); + + has postponed_hooks => ( + is => 'ro', + default => sub { +{ + before => 'that', + after => 'this', + } }, + ); + } + my $runner = Dancer2::Core::Runner->new(); + my $app = App::Fake->new(); + can_ok( $runner, qw<register_application add_postponed_hooks> ); + + is_deeply( + $runner->apps, + [], + 'Apps are empty at first', + ); + + is_deeply( + $runner->postponed_hooks, + +{}, + 'No postponed hooks at first', + ); + + $runner->register_application($app); + + is_deeply( + $runner->apps, + [$app], + 'Runner registered application', + ); + + is_deeply( + $runner->postponed_hooks, + { 'App::Fake' => $app->postponed_hooks }, + 'Runner registered the App\'s postponed hooks', + ); +} + +{ + my $runner = Dancer2::Core::Runner->new(); + can_ok( $runner, qw<start start_server> ); + + $runner->config->{'apphandler'} = 'PSGI'; + $runner->config->{'startup_info'} = 0; + my $app = $runner->start; + isa_ok( $app, 'CODE' ); + + { + package Server::Fake; + sub new { bless {}, 'Server::Fake' } + sub run { + my ( $self, $app ) = @_; + ::isa_ok( $self, 'Server::Fake' ); + ::isa_ok( $app, 'CODE' ); + + return 'OK'; + } + } + + $runner->{'server'} = Server::Fake->new; + my $res = $runner->start_server($app); + is( $res, 'OK', 'start_server works' ); +} + +{ + my $runner = Dancer2::Core::Runner->new(); + can_ok( $runner, 'start' ); + + $runner->config->{'apphandler'} = 'PSGI'; + my $app = $runner->start; + isa_ok( $app, 'CODE' ); +} + diff --git a/t/classes/Dancer2-Core-Runner/psgi_app.t b/t/classes/Dancer2-Core-Runner/psgi_app.t new file mode 100644 index 00000000..ea7c1a2b --- /dev/null +++ b/t/classes/Dancer2-Core-Runner/psgi_app.t @@ -0,0 +1,89 @@ +use strict; +use warnings; +use Test::More tests => 25; +use Plack::Test; +use HTTP::Request::Common; + +{ package App1; use Dancer2; get '/1' => sub {1}; } +{ package App2; use Dancer2; get '/2' => sub {2}; } +{ package App3; use Dancer2; get '/3' => sub {3}; } + +sub is_available { + my ( $cb, @apps ) = @_; + foreach my $app (@apps) { + is( $cb->( GET "/$app" )->content, $app, "App$app available" ); + } +} + +sub isnt_available { + my ( $cb, @apps ) = @_; + foreach my $app (@apps) { + is( + $cb->( GET "/$app" )->code, + 404, + "App$app is not available", + ); + } +} + +note 'All Apps'; { + my $app = Dancer2->psgi_app; + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + is_available( $cb, 1, 2, 3 ); + }; +} + +note 'Specific Apps by parameters'; { + my @apps = @{ Dancer2->runner->apps }[ 0, 2 ]; + is( scalar @apps, 2, 'Took two apps from the Runner' ); + my $app = Dancer2->psgi_app(\@apps); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + is_available( $cb, 1, 3 ); + isnt_available( $cb, 2 ); + }; +} + +note 'Specific Apps via App objects'; { + my $app = App2->psgi_app; + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + is_available( $cb, 2 ); + isnt_available( $cb, 1, 3 ); + }; +}; + +note 'Specific apps by App names'; { + my $app = Dancer2->psgi_app( [ 'App1', 'App3' ] ); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + isnt_available( $cb, 2 ); + is_available( $cb, 1, 3 ); + }; +} + +note 'Specific apps by App names with regular expression, v1'; { + my $app = Dancer2->psgi_app( [ qr/^App1$/, qr/^App3$/ ] ); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + isnt_available( $cb, 2 ); + is_available( $cb, 1, 3 ); + }; +} + +note 'Specific apps by App names with regular expression, v2'; { + my $app = Dancer2->psgi_app( [ qr/^App(2|3)$/ ] ); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + isnt_available( $cb, 1 ); + is_available( $cb, 2, 3 ); + }; +} + diff --git a/t/classes/Dancer2-Core/camelize.t b/t/classes/Dancer2-Core/camelize.t new file mode 100644 index 00000000..ed52f228 --- /dev/null +++ b/t/classes/Dancer2-Core/camelize.t @@ -0,0 +1,22 @@ +use strict; +use warnings; +use Dancer2::Core; +use Test::More tests => 4; + +my %tests = ( + 'test' => 'Test', + 'class_name' => 'ClassName', + 'class_nAME' => 'ClassNAME', + 'class_NAME' => 'ClassNAME', +); + +foreach my $test ( keys %tests ) { + my $value = $tests{$test}; + + is( + Dancer2::Core::camelize($test), + $value, + "$test camelized as $value", + ); +} + diff --git a/t/classes/Dancer2/import-pragmas.t b/t/classes/Dancer2/import-pragmas.t new file mode 100644 index 00000000..734d5048 --- /dev/null +++ b/t/classes/Dancer2/import-pragmas.t @@ -0,0 +1,18 @@ +use strict; +use Test::More tests => 1; + +{ + package App::NoWarnings; ## no critic + no warnings 'misc'; # masks earlier declaration + use Dancer2 ':nopragmas'; + + local $@ = undef; + my $got_warning; + + local $SIG{'__WARN__'} = sub { + $got_warning++; + }; + + eval 'my $var; my $var;'; ## no critic + ::is( $got_warning, undef, 'warnings pragma not activated' ); +} diff --git a/t/classes/Dancer2/import.t b/t/classes/Dancer2/import.t new file mode 100644 index 00000000..c9ef3834 --- /dev/null +++ b/t/classes/Dancer2/import.t @@ -0,0 +1,270 @@ +use strict; +use warnings; +use Test::More tests => 34; +use Test::Fatal; +use Scalar::Util 'refaddr'; +use Plack::Test; +use HTTP::Request::Common; + +BEGIN { + require Dancer2; + can_ok( Dancer2::, 'runner' ); + is( Dancer2::->runner, undef, 'No runner by default' ); +} + +{ + package App::CreatingRunner; + use Dancer2; +} + +isa_ok( Dancer2->runner, 'Dancer2::Core::Runner', 'Runner created' ); +my $runner_refaddr = refaddr( Dancer2->runner ); + +{ + package App::NotRecreatingRunner; + use Dancer2; +} + +isa_ok( Dancer2->runner, 'Dancer2::Core::Runner', 'Runner created' ); +is( refaddr( Dancer2->runner ), $runner_refaddr, 'Runner not recreated' ); + +{ + { + package FakeRunner; + sub psgi_app { + ::isa_ok( $_[0], 'FakeRunner' ); + ::is( $_[1], 'psgi_param', 'psgi_app calls Runner->psgi_app' ); + return 'Got it'; + } + } + + local $Dancer2::runner = bless {}, 'FakeRunner'; + ::is( + Dancer2->psgi_app('psgi_param'), + 'Got it', + 'psgi_app works as expected', + ); +} + +{ + package App::ScriptAllowed; + require Dancer2; + + ::is( + ::exception { Dancer2->import(':script') }, + undef, + ':script is allowed', + ); +} + +{ + package App::TestsAllowed; + require Dancer2; + + ::is( + ::exception { Dancer2->import(':tests') }, + undef, + ':tests is allowed', + ); +} + +{ + package App::SyntaxAllowed; + require Dancer2; + + ::is( + ::exception { Dancer2->import(':syntax') }, + undef, + ':syntax is allowed', + ); +} + +{ + package App::KeyPairOnly; + require Dancer2; + + ::like( + ::exception { Dancer2->import('single') }, + qr{^parameters must be key/value pairs}, + 'Must import key/value pairs', + ); + + ::like( + ::exception { Dancer2->import(qw<three items requested>) }, + qr{^parameters must be key/value pairs}, + 'Must import key/value pairs', + ); + + ::is( + ::exception { Dancer2->import( '!unless' ) }, + undef, + 'Must import key/value pairs unless prefixed by !', + ); + + ::is( + ::exception { Dancer2->import( '!unless', '!prefixed', '!bythis' ) }, + undef, + 'Must import key/value pairs unless prefixed by !', + ); +} + +{ + package App::GettingDSL; + use Dancer2; + + ::can_ok( __PACKAGE__, qw<get post> ); +} + +{ + package App::GettingSelectiveDSL; + use Dancer2 '!post'; + + # proper way + ::can_ok( __PACKAGE__, 'get' ); + + # checking this would work too + ::ok( __PACKAGE__->can('get'), 'get imported successfully' ); + ::ok( ! __PACKAGE__->can('post'), 'Can import keywords selectively' ); +} + +{ + package App::Main; + use Dancer2; + get '/main' => sub {1}; +} + +{ + package App::ComposedToMain; + use Dancer2 appname => 'App::Main'; + get '/alsomain' => sub {1}; +} + +{ + my $runner = Dancer2->runner; + isa_ok( $runner, 'Dancer2::Core::Runner' ); + my $apps = $runner->apps; + + cmp_ok( + scalar @{$apps}, + '==', + 12, + 'Correct number of Apps created so far', + ); + + my @names = sort map +( $_->name ), @{$apps}; + + # this is the list of all Apps loaded in this test + is_deeply( + \@names, + [qw< + App::CreatingRunner + App::GettingDSL + App::GettingSelectiveDSL + App::KeyPairOnly + App::Main + App::NoStrictNoWarningsNoUTF8 + App::NotRecreatingRunner + App::ScriptAllowed + App::StrictAndWarningsAndUTF8 + App::SyntaxAllowed + App::TestsAllowed + App::WithSettingsChanged + >], + 'All apps accounted for', + ); + + my $app = App::Main->to_app; + isa_ok( $app, 'CODE' ); + test_psgi $app, sub { + my $cb = shift; + is( + $cb->( GET '/main' )->content, + 1, + 'Got original app response', + ); + + is( + $cb->( GET '/alsomain' )->content, + 1, + 'Can compose apps with appname', + ); + }; +} + +{ + package App::WithSettingsChanged; + use Dancer2; +} + +{ + App::WithSettingsChanged->import( with => { layout => 'mobile' } ); + + my ($app) = grep +( $_->name eq 'App::WithSettingsChanged' ), + @{ Dancer2->runner->{'apps'} }; + + ::isa_ok( $app, 'Dancer2::Core::App' ); + ::is( + $app->template_engine->{'layout'}, + 'mobile', + 'Changed settings using with keyword', + ); +} + +{ + package App::NoStrictNoWarningsNoUTF8; + use Dancer2; + no strict; + no warnings; + no utf8; + + local $@ = undef; + + eval '$var = 30'; + + ::is( + $@, + '', + 'no strict (control test)', + ); + + local $SIG{'__WARN__'} = sub { + ::is( + $_[0], + undef, + 'no warning (control test)', + ); + }; + + eval 'my $var; my $var;'; + + my $str = "щука"; + ::isnt( length $str, 4, 'utf8 pragma not imported' ); +} + +{ + package App::StrictAndWarningsAndUTF8; + use Dancer2; + + local $@ = undef; + + local $SIG{'__WARN__'} = sub { + ::ok( + $_[0], + 'warnings pragma imported', + ); + }; + + eval '$var = 30;'; + + ::like( + $@, + qr/^Global symbol/, + 'strict pragma imported', + ); + + eval 'my $var; my $var;'; + + my $str = "щука"; + ::is( length $str, 4, 'utf8 pragma imported' ); +} + diff --git a/t/config.yml b/t/config.yml new file mode 100644 index 00000000..33e39171 --- /dev/null +++ b/t/config.yml @@ -0,0 +1,6 @@ +log: "info" +logger: "Note" + +plugins: + "FooPlugin": + plugin: 42 diff --git a/t/config/config.yml b/t/config/config.yml new file mode 100644 index 00000000..032820ba --- /dev/null +++ b/t/config/config.yml @@ -0,0 +1,6 @@ +main: 1 +charset: 'UTF-8' +show_errors: 1 + +application: + some_feature: foo diff --git a/t/config/environments/failure.yml b/t/config/environments/failure.yml new file mode 100644 index 00000000..ea4f9cf9 --- /dev/null +++ b/t/config/environments/failure.yml @@ -0,0 +1,3 @@ +not valid YAML - inconsistent indentation +foo: 42 + bar: baz diff --git a/t/config/environments/merging.yml b/t/config/environments/merging.yml new file mode 100644 index 00000000..ca45c18a --- /dev/null +++ b/t/config/environments/merging.yml @@ -0,0 +1,3 @@ +application: + some_feature: bar + another_setting: baz diff --git a/t/config/environments/production.yml b/t/config/environments/production.yml new file mode 100644 index 00000000..116061c8 --- /dev/null +++ b/t/config/environments/production.yml @@ -0,0 +1,2 @@ +show_errors: 0 +logger: "console" diff --git a/t/config/environments/staging.json b/t/config/environments/staging.json new file mode 100644 index 00000000..2fdea433 --- /dev/null +++ b/t/config/environments/staging.json @@ -0,0 +1,5 @@ +{ + "main": "1", + "charset": 'UTF-8', + "show_errors": "1" +} diff --git a/t/config2/config.yml b/t/config2/config.yml new file mode 100644 index 00000000..14472e88 --- /dev/null +++ b/t/config2/config.yml @@ -0,0 +1,9 @@ +main: 1 +charset: 'UTF-8' +show_errors: 1 + +application: + feature_1: foo + feature_2: bar + feature_3: baz + feature_4: blat diff --git a/t/config2/config_local.yml b/t/config2/config_local.yml new file mode 100644 index 00000000..ce267c13 --- /dev/null +++ b/t/config2/config_local.yml @@ -0,0 +1,4 @@ +application: + feature_2: alpha + feature_5: beta + feature_6: gamma diff --git a/t/config2/environments/lconfig.yml b/t/config2/environments/lconfig.yml new file mode 100644 index 00000000..4f39f636 --- /dev/null +++ b/t/config2/environments/lconfig.yml @@ -0,0 +1,3 @@ +application: + feature_6: bar + feature_7: baz diff --git a/t/config2/environments/lconfig_local.yml b/t/config2/environments/lconfig_local.yml new file mode 100644 index 00000000..14f8fb5c --- /dev/null +++ b/t/config2/environments/lconfig_local.yml @@ -0,0 +1,3 @@ +application: + feature_3: replacement + feature_8: goober diff --git a/t/config_multiapp.t b/t/config_multiapp.t new file mode 100644 index 00000000..a2acc6c4 --- /dev/null +++ b/t/config_multiapp.t @@ -0,0 +1,24 @@ +use strict; +use warnings; + +use Test::More; +use File::Spec; + +use lib '.'; +use t::app::t1::lib::App1; +use t::app::t1::lib::Sub::App2; +use t::app::t2::lib::App3; + +for my $app ( @{ Dancer2->runner->apps } ) { + # Need to determine path to config; use apps' name for now.. + my $path = $app->name eq 'App3' ? 't2' : 't1'; + + is_deeply $app->config_files, + [ File::Spec->rel2abs(File::Spec->catfile( 't', 'app', $path, 'config.yml' )) ], + $app->name . ": config files found"; + + is $app->config->{app}->{config}, 'ok', + $app->name . ": config loaded properly" +} + +done_testing; diff --git a/t/config_reader.t b/t/config_reader.t new file mode 100644 index 00000000..5dd4065e --- /dev/null +++ b/t/config_reader.t @@ -0,0 +1,189 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Carp 'croak'; + +use Dancer2::Core::Runner; +use Dancer2::FileUtils qw/dirname path/; +use File::Spec; +use File::Temp; + +# undefine ENV vars used as defaults for app environment in these tests +local $ENV{DANCER_ENVIRONMENT}; +local $ENV{PLACK_ENV}; + +my $runner = Dancer2::Core::Runner->new(); +my $location = File::Spec->rel2abs( path( dirname(__FILE__), 'config' ) ); +my $location2 = File::Spec->rel2abs( path( dirname(__FILE__), 'config2' ) ); + +{ + + package Prod; + use Moo; + with 'Dancer2::Core::Role::ConfigReader'; + + sub name {'Prod'} + + sub _build_environment {'production'} + sub _build_location {$location} + sub _build_default_config {$runner->config} + + package Dev; + use Moo; + with 'Dancer2::Core::Role::ConfigReader'; + + sub _build_environment {'development'} + sub _build_location {$location}; + sub _build_default_config {$runner->config} + + package Failure; + use Moo; + with 'Dancer2::Core::Role::ConfigReader'; + + sub _build_environment {'failure'} + sub _build_location {$location} + sub _build_default_config {$runner->config} + + package Staging; + use Moo; + with 'Dancer2::Core::Role::ConfigReader'; + + sub _build_environment {'staging'} + sub _build_location {$location} + sub _build_default_config {$runner->config} + + package Merging; + use Moo; + with 'Dancer2::Core::Role::ConfigReader'; + + sub name {'Merging'} + + sub _build_environment {'merging'} + sub _build_location {$location} + sub _build_default_config {$runner->config} + + package LocalConfig; + use Moo; + with 'Dancer2::Core::Role::ConfigReader'; + + sub name {'LocalConfig'} + + sub _build_environment {'lconfig'} + sub _build_location {$location2} + sub _build_default_config {$runner->config} + +} + +my $d = Dev->new(); +is_deeply $d->config_files, + [ path( $location, 'config.yml' ), ], + "config_files() only sees existing files"; + +my $f = Prod->new; +is $f->does('Dancer2::Core::Role::ConfigReader'), 1, + "role Dancer2::Core::Role::ConfigReader is consumed"; + +is_deeply $f->config_files, + [ path( $location, 'config.yml' ), + path( $location, 'environments', 'production.yml' ), + ], + "config_files() works"; + +my $j = Staging->new; +is_deeply $j->config_files, + [ path( $location, 'config.yml' ), + path( $location, 'environments', 'staging.json' ), + ], + "config_files() does JSON too!"; + +note "bad YAML file"; +my $fail = Failure->new; +is $fail->environment, 'failure'; + +is_deeply $fail->config_files, + [ path( $location, 'config.yml' ), + path( $location, 'environments', 'failure.yml' ), + ], + "config_files() works"; + +like( + exception { $fail->config }, + qr{Unable to parse the configuration file}, 'Configuration file parsing failure', +); + +note "config merging"; +my $m = Merging->new; + +# Check the 'application' top-level key; its the only key that +# is currently a HoH in the test configurations +is_deeply $m->config->{application}, + { some_feature => 'bar', + another_setting => 'baz', + }, + "full merging of configuration hashes"; + +{ + my $l = LocalConfig->new; + + is_deeply $l->config_files, + [ path( $location2, 'config.yml' ), + path( $location2, 'config_local.yml' ), + path( $location2, 'environments', 'lconfig.yml' ), + path( $location2, 'environments', 'lconfig_local.yml' ), + ], + "config_files() with local config works"; + + is_deeply $l->config->{application}, + { feature_1 => 'foo', + feature_2 => 'alpha', + feature_3 => 'replacement', + feature_4 => 'blat', + feature_5 => 'beta', + feature_6 => 'bar', + feature_7 => 'baz', + feature_8 => 'goober', + }, + "full merging of local configuration hashes"; + +} + +note "config parsing"; + +is $f->config->{show_errors}, 0; +is $f->config->{main}, 1; +is $f->config->{charset}, 'utf-8', "normalized UTF-8 to utf-8"; + +ok( $f->has_setting('charset') ); +ok( !$f->has_setting('foobarbaz') ); + +note "default values"; +is $f->setting('apphandler'), 'Standalone'; + +like( + exception { $f->_normalize_config( { charset => 'BOGUS' } ) }, + qr{Charset defined in configuration is wrong : couldn't identify 'BOGUS'}, + 'Configuration file charset failure', +); + +{ + + package Foo; + use Carp 'croak'; + sub foo { croak "foo" } +} + +is $f->setting('traces'), 0; +unlike( exception { Foo->foo() }, qr{Foo::foo}, "traces are not enabled", ); + +$f->setting( traces => 1 ); +like( exception { Foo->foo() }, qr{Foo::foo}, "traces are enabled", ); + +{ + my $tmpdir = File::Temp::tempdir( CLEANUP => 1, TMPDIR => 1 ); + $ENV{DANCER_CONFDIR} = $tmpdir; + my $f = Prod->new; + is $f->config_location, $tmpdir; +} + +done_testing; diff --git a/t/config_settings.t b/t/config_settings.t new file mode 100644 index 00000000..d4df716f --- /dev/null +++ b/t/config_settings.t @@ -0,0 +1,31 @@ +use strict; +use warnings; + +use Test::More; + +use Dancer2; + +# testing default values +is( setting('port'), '3000', "default value for 'port' is OK" ); +is( setting('content_type'), 'text/html', + "default value for 'content_type' is OK" +); + +#should we test for all default values? + + +# testing new settings +ok( setting( 'foo' => '42' ), 'setting a new value' ); +is( setting('foo'), 42, 'new value has been set' ); + +# test the alias 'set' +ok( set( bar => 43 ), 'setting bar with set' ); +is( setting('bar'), 43, 'new value has been set' ); + +#multiple values +ok( setting( 'foo' => 43, bar => 44 ), 'set multiple values' ); +ok( setting('foo') == 43 && setting('bar') == 44, + 'set multiple values successful' +); + +done_testing; diff --git a/t/context-in-before.t b/t/context-in-before.t new file mode 100644 index 00000000..fd4c74e9 --- /dev/null +++ b/t/context-in-before.t @@ -0,0 +1,57 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 10; +use Plack::Test; +use HTTP::Request::Common; + +my $before; +{ + package OurApp; + use Dancer2 '!pass'; + use Test::More; + + hook before => sub { + my $ctx = shift; + + isa_ok( + $ctx, + 'Dancer2::Core::App', + 'Context is actually an app now', + ); + + is( $ctx->name, 'OurApp', 'It is the correct app' ); + can_ok( $ctx, 'app' ); + + my $app = $ctx->app; + isa_ok( + $app, + 'Dancer2::Core::App', + 'When called ->app, we get te app again', + ); + + is( $app->name, 'OurApp', 'It is the correct app' ); + is( $ctx, $app, 'Same exact application (by reference)' ); + + $before++; + }; + + get '/' => sub {'OK'}; +} + +my $app = OurApp->to_app; +isa_ok( $app, 'CODE', 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/' ); + + is( $res->code, 200, '[GET /] status OK' ); + is( $res->content, 'OK', '[GET /] content OK' ); + + ok( $before == 1, 'before hook called' ); +}; + + diff --git a/t/cookie.t b/t/cookie.t new file mode 100644 index 00000000..ac82b528 --- /dev/null +++ b/t/cookie.t @@ -0,0 +1,207 @@ +use strict; +use warnings; +use Test::Fatal; +use Test::More; + +BEGIN { + + # Freeze time at Tue, 15-Jun-2010 00:00:00 GMT + *CORE::GLOBAL::time = sub { return 1276560000 } +} + +use Dancer2::Core::Cookie; +use Dancer2::Core::Request; + +diag "If you want extra speed, install HTTP::XSCookies" + if !Dancer2::Core::Cookie::_USE_XS; + +sub run_test { + + note "Constructor"; + + my $cookie = Dancer2::Core::Cookie->new( name => "foo" ); + + isa_ok $cookie => 'Dancer2::Core::Cookie'; + can_ok $cookie => 'to_header'; + + + note "Setting values"; + + is $cookie->value("foo") => "foo", "Can set value"; + is $cookie->value => "foo", "Set value stuck"; + + is $cookie . "bar", "foobar", "Stringifies to desired value"; + + ok $cookie->value( [qw(a b c)] ), "can set multiple values"; + is $cookie->value => 'a', "get first value in scalar context"; + is_deeply [ $cookie->value ] => [qw(a b c)], + "get all values in list context";; + + ok $cookie->value( { x => 1, y => 2 } ), "can set values with a hashref"; + like $cookie->value => qr/^[xy]$/; # hashes doesn't store order... + is_deeply [ sort $cookie->value ] => [ sort ( 1, 2, 'x', 'y' ) ]; + + + note "accessors and defaults"; + + is $cookie->name => 'foo', "name is as expected"; + is $cookie->name("bar") => "bar", "can change name"; + is $cookie->name => 'bar', "name change stuck"; + + ok !$cookie->domain, "no domain set by default"; + is $cookie->domain("dancer.org") => "dancer.org", + "setting domain returns new value"; + is $cookie->domain => "dancer.org", + "new domain valjue stuck"; + is $cookie->domain("") => "", "can clear domain"; + ok !$cookie->domain, "no domain set now"; + + is $cookie->path => '/', "by default, path is /"; + ok $cookie->has_path, "has_path"; + is $cookie->path("/foo") => "/foo", "setting path returns new value"; + ok $cookie->has_path, "has_path"; + is $cookie->path => "/foo", "new path stuck"; + + ok !$cookie->secure, "no cookie secure flag by default"; + is $cookie->secure(1) => 1, "enabling \$cookie->secure returns new value"; + is $cookie->secure => 1, "\$cookie->secure flag is enabled"; + is $cookie->secure(0) => 0, "disabling \$cookie->secure returns new value"; + ok !$cookie->secure, "\$cookie->secure flag is disabled"; + + ok $cookie->http_only, "http_only by default"; + is $cookie->http_only(0) => 0, + "disabling \$cookie->http_only returns new value"; + ok !$cookie->http_only, + "\$cookie->http_only is now disabled"; + + like exception { $cookie->same_site('foo') }, + qr/Value "foo" did not pass type constraint "Enum\["Strict","Lax"\]/; + + note "expiration strings"; + + my $min = 60; + my $hour = 60 * $min; + my $day = 24 * $hour; + my $week = 7 * $day; + my $mon = 30 * $day; + my $year = 365 * $day; + + ok !$cookie->expires; + my %times = ( + "+2" => "Tue, 15-Jun-2010 00:00:02 GMT", + "+2h" => "Tue, 15-Jun-2010 02:00:00 GMT", + "-2h" => "Mon, 14-Jun-2010 22:00:00 GMT", + "1 hour" => "Tue, 15-Jun-2010 01:00:00 GMT", + "3 weeks 4 days 2 hours 99 min 0 secs" => "Sat, 10-Jul-2010 03:39:00 GMT", + "2 months" => "Sat, 14-Aug-2010 00:00:00 GMT", + "12 years" => "Sun, 12-Jun-2022 00:00:00 GMT", + + 1288817656 => "Wed, 03-Nov-2010 20:54:16 GMT", + 1288731256 => "Tue, 02-Nov-2010 20:54:16 GMT", + 1288644856 => "Mon, 01-Nov-2010 20:54:16 GMT", + 1288558456 => "Sun, 31-Oct-2010 20:54:16 GMT", + 1288472056 => "Sat, 30-Oct-2010 20:54:16 GMT", + 1288385656 => "Fri, 29-Oct-2010 20:54:16 GMT", + 1288299256 => "Thu, 28-Oct-2010 20:54:16 GMT", + 1288212856 => "Wed, 27-Oct-2010 20:54:16 GMT", + + # Anything not understood is passed through + "basset hounds got long ears" => "basset hounds got long ears", + "+2 something" => "+2 something", + ); + + for my $exp ( keys %times ) { + my $want = $times{$exp}; + + $cookie->expires($exp); + is $cookie->expires => $want, "expiry $exp => $want";; + } + + + note "to header"; + + my @cake = ( + { cookie => { + name => 'bar', + value => 'foo', + expires => '+2h', + secure => 1 + }, + expected => sprintf( + "bar=foo; Expires=%s; HttpOnly; Path=/; Secure", + $times{'+2h'}, + ), + }, + { cookie => { + name => 'bar', + value => 'foo', + domain => 'dancer.org', + path => '/dance', + http_only => 1 + }, + expected => "bar=foo; Domain=dancer.org; HttpOnly; Path=/dance", + }, + { cookie => { + name => 'bar', + value => 'foo', + }, + expected => "bar=foo; HttpOnly; Path=/", + }, + { cookie => { + name => 'bar', + value => 'foo', + http_only => 0, + }, + expected => "bar=foo; Path=/", + }, + { cookie => { + name => 'bar', + value => 'foo', + http_only => '0', + }, + expected => "bar=foo; Path=/", + }, + { cookie => { + name => 'same-site', + value => 'strict', + same_site => 'Strict', + }, + expected => 'same-site=strict; HttpOnly; Path=/; SameSite=Strict', + }, + { cookie => { + name => 'same-site', + value => 'lax', + same_site => 'Lax', + }, + expected => 'same-site=lax; HttpOnly; Path=/; SameSite=Lax', + }, + ); + + for my $cook (@cake) { + my $c = Dancer2::Core::Cookie->new(%{$cook->{cookie}}); + # name=value; sorted fields + my @a = split /; /, $c->to_header; + is join("; ", shift @a, sort @a), $cook->{expected}; + } + + note 'multi-value'; + + my $c = Dancer2::Core::Cookie->new( name => 'foo', value => [qw/bar baz/] ); + + is $c->to_header, 'foo=bar&baz; Path=/; HttpOnly'; + + my $r = Dancer2::Core::Request->new( env => { HTTP_COOKIE => 'foo=bar&baz' } ); + + is_deeply [ $r->cookies->{foo}->value ], [qw/bar baz/]; +} + +note "Run test with XS_HTTP_COOKIES" if Dancer2::Core::Cookie::_USE_XS; +run_test(); +if ( Dancer2::Core::Cookie::_USE_XS ) { + note "Run test without XS_HTTP_COOKIES"; + no warnings 'redefine'; + *Dancer2::Core::Cookie::to_header = \&Dancer2::Core::Cookie::pp_to_header; + run_test(); +} + +done_testing; diff --git a/t/corpus/pretty/505.tt b/t/corpus/pretty/505.tt new file mode 100644 index 00000000..25c53d71 --- /dev/null +++ b/t/corpus/pretty/505.tt @@ -0,0 +1,4 @@ +Template selected. + +message: [% content %] +status: [% status %] diff --git a/t/corpus/pretty/relative.tt b/t/corpus/pretty/relative.tt new file mode 100644 index 00000000..4deb0273 --- /dev/null +++ b/t/corpus/pretty/relative.tt @@ -0,0 +1,3 @@ +Template [% component.name %] + +[% INCLUDE 505.tt %] diff --git a/t/corpus/pretty_public/404.html b/t/corpus/pretty_public/404.html new file mode 100644 index 00000000..fe50ecd4 --- /dev/null +++ b/t/corpus/pretty_public/404.html @@ -0,0 +1 @@ +<html><body><h1>Yup, you're lost</h1></body></html> diff --git a/t/corpus/pretty_public/510.html b/t/corpus/pretty_public/510.html new file mode 100644 index 00000000..08e89711 --- /dev/null +++ b/t/corpus/pretty_public/510.html @@ -0,0 +1 @@ +Static page. diff --git a/t/corpus/static/1x1.png b/t/corpus/static/1x1.png Binary files differnew file mode 100644 index 00000000..1914264c --- /dev/null +++ b/t/corpus/static/1x1.png diff --git a/t/corpus/static/index.html b/t/corpus/static/index.html new file mode 100644 index 00000000..2da8ed9d --- /dev/null +++ b/t/corpus/static/index.html @@ -0,0 +1,10 @@ +<!DOCTYPE html> +<html> + <head> + <title>Unicode test</title> + </head> + <body> + <h1>Hello, UTF-8</h1> + <p>áéíóú</p> + </body> +</html> diff --git a/t/custom_dsl.t b/t/custom_dsl.t new file mode 100644 index 00000000..c82a5fcb --- /dev/null +++ b/t/custom_dsl.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; + +use FindBin qw($Bin); +use lib "$Bin/lib"; +use Dancer2 dsl => 'MyDancerDSL'; + +envoie '/' => sub { + request->method; +}; + +prend '/' => sub { + proto { ::ok('in proto') }; # no sub! + request->method; +}; + + +my $test = Plack::Test->create( __PACKAGE__->to_app ); + +is( $test->request( GET '/' )->content, + 'GET', '[GET /] Correct content' +); +is( $test->request( POST '/' )->content, + 'POST', '[POST /] Correct content' +); + +done_testing(); diff --git a/t/dancer-test.t b/t/dancer-test.t new file mode 100644 index 00000000..fdece388 --- /dev/null +++ b/t/dancer-test.t @@ -0,0 +1,153 @@ +# who test the tester? We do! + +use strict; +use warnings; +use File::Spec; +use File::Basename qw/dirname/; +use Ref::Util qw<is_arrayref>; + +BEGIN { + # Disable route handlers so we can actually test route_exists + # and route_doesnt_exist. Use config that disables default route handlers. + $ENV{DANCER_CONFDIR} = File::Spec->catdir(dirname(__FILE__), 'dancer-test'); +} + +use Test::More tests => 50; + +use Dancer2; +use Dancer2::Test; +use Dancer2::Core::Request; +use File::Temp; +use Encode; +use URI::Escape; + +$Dancer2::Test::NO_WARN = 1; + +my @routes = ( + '/foo', + [ GET => '/foo' ], + Dancer2::Core::Request->new( + env => { + 'psgi.url_scheme' => 'http', + REQUEST_METHOD => 'GET', + QUERY_STRING => '', + SERVER_NAME => 'localhost', + SERVER_PORT => 5000, + SERVER_PROTOCOL => 'HTTP/1.1', + SCRIPT_NAME => '', + PATH_INFO => '/foo', + REQUEST_URI => '/foo', + } + ), +); +my $fighter = Dancer2::Core::Response->new( + content => 'fighter', + status => 404, +); + +route_doesnt_exist $_ for (@routes, $fighter); + + +get '/foo' => sub {'fighter'}; + +route_exists $_, "route $_ exists" for @routes; + +$fighter->status(200); +push @routes, $fighter; + +for (@routes) { + my $response = dancer_response $_; + isa_ok $response => 'Dancer2::Core::Response'; + is $response->content => 'fighter'; +} + +response_content_is $_ => 'fighter', "response_content_is with $_" for @routes; +response_content_isnt $_ => 'platypus', "response_content_isnt with $_" + for @routes; +response_content_like $_ => qr/igh/ for @routes; +response_content_unlike $_ => qr/ought/ for @routes; + +response_status_is $_ => 200 for @routes; +response_status_isnt $_ => 203 for @routes; + +response_headers_include $_ => [ Server => "Perl Dancer2 " . Dancer2->VERSION ] + for @routes; + +## Check parameters get through ok +get '/param' => sub { param('test') }; +my $param_response = + dancer_response( GET => '/param', { params => { test => 'hello' } } ); +is $param_response->content, 'hello', 'PARAMS get echoed by route'; + +post '/upload' => sub { + my $file = upload('test'); + return $file->content; +}; +## Check we can upload files +my $file_response = dancer_response( + POST => '/upload', + { files => + [ { filename => 'test.txt', name => 'test', data => 'testdata' } ] + } +); +is $file_response->content, 'testdata', 'file uploaded with supplied data'; + +my $temp = File::Temp->new; +print $temp 'testfile'; +close($temp); + +$file_response = + dancer_response( POST => '/upload', + { files => [ { filename => $temp->filename, name => 'test' } ] } ); +is $file_response->content, 'testfile', 'file uploaded with supplied filename'; + +## Check multiselect/multi parameters get through ok +get '/multi' => sub { + my $t = param('test'); + return 'bad' if !is_arrayref($t); + my $p = join( '', @$t ); + return $p; +}; +$param_response = + dancer_response( GET => '/multi', + { params => { test => [ 'foo', 'bar' ] } } ); +is $param_response->content, 'foobar', + 'multi values for same key get echoed back'; + +my $russian_test = + decode( 'UTF-8', + uri_unescape("%D0%B8%D1%81%D0%BF%D1%8B%D1%82%D0%B0%D0%BD%D0%B8%D0%B5") ); +$param_response = + dancer_response( GET => '/multi', + { params => { test => [ 'test/', $russian_test ] } } ); +is $param_response->content, 'test/' . encode( 'UTF-8', $russian_test ), + 'multi utf8 value properly merge'; + +get '/headers' => sub { + join " : ", request->header('X-Sent-By'), request->cookies->{foo}; +}; +note "extra headers in request"; +sub extra_headers { + my $sent_by = 'Dancer2::Test'; + my $headers_test = dancer_response( GET => '/headers', + { + headers => [ + [ 'X-Sent-By' => $sent_by ], + [ 'Cookie' => "foo=bar" ], + ], + } + ); + is $headers_test->content, "$sent_by : bar", + "extra headers included in request"; +} + +note "Run extra_headers test with XS_HTTP_COOKIES" + if $Dancer2::Core::Request::XS_HTTP_COOKIES; +extra_headers(); +SKIP: { + skip "HTTP::XSCookies not installed", 1 + if !$Dancer2::Core::Request::XS_HTTP_COOKIES; + note "Run extra_headers test without XS_HTTP_COOKIES"; + $Dancer2::Core::Request::XS_HTTP_COOKIES = 0; + extra_headers(); +} diff --git a/t/dancer-test/config.yml b/t/dancer-test/config.yml new file mode 100644 index 00000000..75d8d745 --- /dev/null +++ b/t/dancer-test/config.yml @@ -0,0 +1 @@ +route_handlers: [] diff --git a/t/deserialize.t b/t/deserialize.t new file mode 100644 index 00000000..4ed051bd --- /dev/null +++ b/t/deserialize.t @@ -0,0 +1,215 @@ +use strict; +use warnings; + +use Test::More tests => 15; +use Plack::Test; +use HTTP::Request::Common; +use Dancer2::Logger::Capture; + +my $logger = Dancer2::Logger::Capture->new; +isa_ok( $logger, 'Dancer2::Logger::Capture' ); + +{ + package App; + use Dancer2; + + # default, we're actually overriding this later + set serializer => 'JSON'; + + # for now + set logger => 'Console'; + + put '/from_params' => sub { + my %p = params(); + return [ map +( $_ => $p{$_} ), sort keys %p ]; + }; + + put '/from_data' => sub { + my $p = request->data; + return [ map +( $_ => $p->{$_} ), sort keys %{$p} ]; + }; + + # This route is used for both toure and body params. + post '/from/:town' => sub { + my $p = params; + return [ map +( $_ => $p->{$_} ), sort keys %{$p} ]; + }; + + any [qw/del patch/] => '/from/:town' => sub { + my $p = params('body'); + return [ map +( $_ => $p->{$_} ), sort keys %{$p} ]; + }; +} + +my $test = Plack::Test->create( App->to_app ); + +subtest 'PUT request with parameters' => sub { + for my $type ( qw<params data> ) { + my $res = $test->request( + PUT "/from_$type", + 'Content-Type' => 'application/json', + Content => '{ "foo": 1, "bar": 2 }' + ); + + is( + $res->content, + '["bar",2,"foo",1]', + "Parameters deserialized from $type", + ); + } +}; + +my $app = App->to_app; +use utf8; +use JSON::MaybeXS; +use Encode; +use Module::Runtime 'use_module'; + +note "Verify Serializers decode into characters"; { + my $utf8 = '∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i)'; + + test_psgi $app, sub { + my $cb = shift; + + for my $type ( qw/Dumper JSON YAML/ ) { + my $class = "Dancer2::Serializer::$type"; + use_module($class); + + my $serializer = $class->new(); + my $body = $serializer->serialize({utf8 => $utf8}); + + # change the app serializer + # we're overiding a RO attribute only for this test! + Dancer2->runner->apps->[0]->set_serializer_engine( + $serializer + ); + + my $r = $cb->( + PUT '/from_params', + 'Content-Type' => $serializer->content_type, + Content => $body, + ); + + my $content = Encode::decode( 'UTF-8', $r->content ); + + # Dumper is a jerk and represents it in Perl \x{...} notation + + if ( $type eq 'Dumper' ) { + { + no strict; + $content = eval $content; + } + + # now $content is an actual ref again + is_deeply( + $content, + [ 'utf8', $utf8 ], + "utf-8 string returns the same using the $type serializer", + ) + } else { + like( + $content, + qr{\Q$utf8\E}, + "utf-8 string returns the same using the $type serializer", + ); + } + } + }; +} + +# default back to JSON for the rest +# we're overiding a RO attribute only for this test! +Dancer2->runner->apps->[0]->set_serializer_engine( + Dancer2::Serializer::JSON->new +); + +note "Decoding of mixed route and deserialized body params"; { + # Check integers from request body remain integers + # but route params get decoded. + test_psgi $app, sub { + my $cb = shift; + + my @req_params = ( + "/from/D\x{c3}\x{bc}sseldorf", # /from/d%C3%BCsseldorf + 'Content-Type' => 'application/json', + Content => JSON::MaybeXS::encode_json({ population => 592393 }), + ); + + my $r = $cb->( POST @req_params ); + + # Watch out for hash order randomization.. + is_deeply( + $r->content, + '["population",592393,"town","'."D\x{c3}\x{bc}sseldorf".'"]', + "Integer from JSON body remains integer and route params decoded", + ); + }; +} + +# Check body is deserialized on PATCH and DELETE. +# The RFC states the behaviour for DELETE is undefined; We take the lenient +# and deserialize it. +# http://tools.ietf.org/html/draft-ietf-httpbis-p2-semantics-24#section-4.3.5 +note "Deserialze any body content that is allowed or undefined"; { + test_psgi $app, sub { + my $cb = shift; + + for my $method ( qw/DELETE PATCH/ ) { + my $request = HTTP::Request->new( + $method, + "/from/D\x{c3}\x{bc}sseldorf", # /from/d%C3%BCsseldorf + [ 'Content-Type' => 'application/json' ], + JSON::MaybeXS::encode_json({ population => 592393 }), + ); + my $response = $cb->($request); + my $content = Encode::decode( 'UTF-8', $response->content ); + + # Only body params returned + is( + $content, + '["population",592393]', + "JSON body deserialized for " . uc($method) . " requests", + ); + } + } +} + +note 'Check serialization errors'; { + Dancer2->runner->apps->[0]->set_serializer_engine( + Dancer2::Serializer::JSON->new( log_cb => sub { $logger->log(@_) } ) + ); + + test_psgi $app, sub { + my $cb = shift; + + $cb->( + PUT '/from_params', + 'Content-Type' => 'application/json', + Content => '---', + ); + + my $trap = $logger->trapper; + isa_ok( $trap, 'Dancer2::Logger::Capture::Trap' ); + + my $errors = $trap->read; + isa_ok( $errors, 'ARRAY' ); + is( scalar @{$errors}, 1, 'One error caught' ); + + my $msg = $errors->[0]; + delete $msg->{'formatted'}; + isa_ok( $msg, 'HASH' ); + is( scalar keys %{$msg}, 2, 'Two items in the error' ); + + is( $msg->{'level'}, 'core', 'Correct level' ); + like( + $msg->{'message'}, + qr{ + ^ + \QFailed to deserialize content: \E + \Qmalformed number\E + }x, + 'Correct error message', + ); + } +} + diff --git a/t/disp_named_capture.t b/t/disp_named_capture.t new file mode 100644 index 00000000..1fdf4048 --- /dev/null +++ b/t/disp_named_capture.t @@ -0,0 +1,35 @@ +use warnings; +use strict; + +use Plack::Test; +use HTTP::Request; +use Test::More tests => 2; + +{ + package app; + use Dancer2; + get '/1' => sub { + return '1'; + }; + get '/2' => sub { + return '2'; + }; +} + +my $test = Plack::Test->create( app->to_app ); +my $request = HTTP::Request->new( GET => 'http://localhost/1' ); +my $response = $test->request( $request ); +is( $response->content, 1 ); + +# "Dummy" regex to populate global $+ +# eval'd as named captures are not available until 5.10 +my $c; +eval <<'NAMED'; +"12345" =~ m#(?<capture>23)#; +$c = $+{capture}; +NAMED + +$request = HTTP::Request->new( GET => 'http://localhost/2' ); +$response = $test->request( $request ); +is( $response->content, 2 ); + diff --git a/t/dispatcher.t b/t/dispatcher.t new file mode 100644 index 00000000..cbda6ad3 --- /dev/null +++ b/t/dispatcher.t @@ -0,0 +1,251 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Carp 'croak'; +use Ref::Util qw<is_regexpref>; + +use Dancer2; +use Dancer2::Core::App; +use Dancer2::Core::Route; +use Dancer2::Core::Dispatcher; +use Dancer2::Core::Hook; +use Dancer2::Core::Response; + +set logger => 'Null'; + +# init our test fixture +my $buffer = {}; +my $app = Dancer2::Core::App->new( name => 'main' ); + +$app->setting( logger => engine('logger') ); +$app->setting( show_errors => 1 ); + +# a simple / route +my $simple_route = $app->add_route( + method => 'get', + regexp => '/', + code => sub {"home"}, +); + +# an error route +my $error_route = $app->add_route( + method => 'get', + regexp => '/error', + code => sub { Fail->fail }, +); + +# A chain of two route for /user/$foo +my $user_name_route = $app->add_route( + method => 'get', + regexp => '/user/:name', + code => sub { + my $app = shift; + $buffer->{user} = $app->request->params->{'name'}; + $app->response->has_passed(1); + }, +); + +my $user_splat_route = $app->add_route( + method => 'get', + regexp => '/user/*?', + code => sub { + my $app = shift; + "Hello " . $app->request->params->{'name'}; + }, +); + +# a route with a 204 response +my $removed_content_route = $app->add_route( + method => 'get', + regexp => '/twoohfour', + code => sub { + my $app = shift; + $app->response->status(204); + "This content should be removed"; + }, +); + +my $route_from_request; + +# simulates a redirect with halt +$app->add_hook( + Dancer2::Core::Hook->new( + name => 'before', + code => sub { + my $app = shift; + $route_from_request = $app->request->route; + if ( $app->request->path_info eq '/haltme' ) { + $app->response->header( Location => 'http://perldancer.org' ); + $app->response->status(302); + $app->response->is_halted(1); + } + }, + ) +); + +my $was_in_second_filter = 0; +$app->add_hook( + Dancer2::Core::Hook->new( + name => 'before', + code => sub { + my $app = shift; + if ( $app->request->path_info eq '/haltme' ) { + $was_in_second_filter = + 1; # should not happen because first filter halted the flow + } + }, + ) +); + +my $halt_route = $app->add_route( + method => 'get', + regexp => '/haltme', + code => sub {"should not get there"}, +); +# the tests +my @tests = ( + { env => { + REQUEST_METHOD => 'GET', + PATH_INFO => '/', + }, + expected => [ + 200, + [ 'Content-Length' => 4, + 'Content-Type' => 'text/html; charset=UTF-8', + 'Server' => "Perl Dancer2 " . Dancer2->VERSION, + ], + ["home"], + $simple_route, + ] + }, + { env => { + REQUEST_METHOD => 'GET', + PATH_INFO => '/user/Johnny', + }, + expected => [ + 200, + [ 'Content-Length' => 12, + 'Content-Type' => 'text/html; charset=UTF-8', + 'Server' => "Perl Dancer2 " . Dancer2->VERSION, + ], + ["Hello Johnny"], + $user_splat_route, # the second, after the first pass()es + ] + }, + { env => { + REQUEST_METHOD => 'GET', + PATH_INFO => '/twoohfour', + }, + expected => [ + 204, + [ 'Content-Type' => 'text/html; charset=UTF-8', + 'Server' => "Perl Dancer2 " . Dancer2->VERSION, + ], + [], + $removed_content_route, + ] + }, + { env => { + REQUEST_METHOD => 'GET', + PATH_INFO => '/haltme', + }, + expected => [ + 302, + [ 'Location' => 'http://perldancer.org', + 'Content-Length' => '305', + 'Content-Type' => 'text/html; charset=utf-8', + 'Server' => "Perl Dancer2 " . Dancer2->VERSION, + ], + qr/This item has moved/, + $halt_route, + ] + }, + +# NOT SUPPORTED YET +# { env => { +# REQUEST_METHOD => 'GET', +# PATH_INFO => '/admin', +# }, +# expected => [200, [], ["home"]] +# }, + + +); + +$app->compile_hooks; + +plan tests => 20; + +my $dispatcher = Dancer2::Core::Dispatcher->new( apps => [$app] ); +my $counter = 0; +foreach my $test (@tests) { + my $env = $test->{env}; + my $expected = $test->{expected}; + my $path = $env->{'PATH_INFO'}; + + $route_from_request = undef; + + diag sprintf "Dispatch test %d, for %s %s", + $counter, + $test->{env}{REQUEST_METHOD}, + $test->{env}{PATH_INFO}; + + my $resp = $dispatcher->dispatch($env); + + is( $resp->[0], $expected->[0], "[$path] Return code ok" ); + + my %got_headers = @{ $resp->[1] }; + my %exp_headers = @{ $expected->[1] }; + is_deeply( \%got_headers, \%exp_headers, "[$path] Correct headers" ); + + if ( is_regexpref( $expected->[2] ) ) { + like $resp->[2][0] => $expected->[2], "[$path] Contents ok. (test $counter)"; + } + else { + is_deeply $resp->[2] => $expected->[2], "[$path] Contents ok. (test $counter)"; + } + + + is( + $route_from_request, # squirreled away by before hook, + $expected->[3], + "Expected route is stored in request (test $counter)", + ); + + $counter++; +} + +foreach my $test ( + { env => { + REQUEST_METHOD => 'GET', + PATH_INFO => '/error', + 'psgi.uri_scheme' => 'http', + SERVER_NAME => 'localhost', + SERVER_PORT => 5000, + SERVER_PROTOCOL => 'HTTP/1.1', + }, + expected => [ + 500, + [ 'Content-Length', "Content-Type", 'text/html' ], + qr!Internal Server Error.*Can't locate object method "fail" via package "Fail" \(perhaps you forgot to load "Fail"\?\) at t[\\/]dispatcher\.t line \d+\.!s + ] + } + ) +{ + my $env = $test->{env}; + my $expected = $test->{expected}; + + my $psgi_response = $dispatcher->dispatch($env); + my $resp = Dancer2::Core::Response->new( + status => $psgi_response->[0], + headers => $psgi_response->[1], + content => $psgi_response->[2][0], + ); + + is $resp->status => $expected->[0], "Return code ok."; + ok( $resp->header('Content-Length') >= 140, "Length ok." ); + like $resp->content, $expected->[2], "contents ok"; +} + + +is $was_in_second_filter, 0, "didn't enter the second filter, because of halt"; diff --git a/t/dsl/any.t b/t/dsl/any.t new file mode 100644 index 00000000..3954e603 --- /dev/null +++ b/t/dsl/any.t @@ -0,0 +1,48 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + any [ 'get', 'post' ] => '/test' => sub { request->method }; + any '/all' => sub { request->method }; +} + +my $test = Plack::Test->create( App->to_app ); + +subtest 'any with params' => sub { + my @success = qw<GET POST>; + my @fails = qw<PUT DELETE OPTIONS PATCH NONEXIST>; + + foreach my $method (@success) { + my $req = HTTP::Request->new( $method => '/test' ); + is( + $test->request($req)->content, + $method, + "Method $method works", + ); + } + + foreach my $method (@fails) { + my $req = HTTP::Request->new( $method => '/test' ); + ok( + ! $test->request($req)->is_success, + "Method $method doesn't exist", + ); + } +}; + +subtest 'any without params' => sub { + foreach my $method ( qw<GET POST PUT DELETE OPTIONS PATCH> ) { + my $req = HTTP::Request->new( $method => '/all' ); + is( + $test->request($req)->content, + $method, + "Method $method works", + ); + } +}; + diff --git a/t/dsl/app.t b/t/dsl/app.t new file mode 100644 index 00000000..9f891888 --- /dev/null +++ b/t/dsl/app.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + get '/' => sub { + my $app = app; + ::isa_ok( $app, 'Dancer2::Core::App' ); + ::is( $app->name, 'App', 'Correct app name' ); + }; +} + +Plack::Test->create( App->to_app )->request( GET '/' ); + diff --git a/t/dsl/content.t b/t/dsl/content.t new file mode 100644 index 00000000..68e5f5d1 --- /dev/null +++ b/t/dsl/content.t @@ -0,0 +1,49 @@ +use strict; +use warnings; +use Test::More tests => 1; +use Plack::Test; +use HTTP::Request::Common; + +my $logger; +{ + package App::ContentFail; ## no critic + use Dancer2; + set show_errors => 1; + set logger => 'Capture'; + + $logger = app->engine('logger'); + + get '/' => sub { content 'Foo' }; +} + +subtest 'content keyword can only be used within delayed response' => sub { + my $test = Plack::Test->create( App::ContentFail->to_app ); + my $res = $test->request( GET '/' ); + ok( ! $res->is_success, 'Request failed' ); + is( $res->code, 500, 'Correct response code' ); + like( + $res->content, + qr/Cannot use content keyword outside delayed response/, + 'Failed to use content keyword outside delayed response', + ); + + isa_ok( $logger, 'Dancer2::Logger::Capture' ); + my $trapper = $logger->trapper; + isa_ok( $trapper, 'Dancer2::Logger::Capture::Trap' ); + + my $error = $trapper->read; + isa_ok( $error, 'ARRAY' ); + is( scalar @{$error}, 1, 'Only one error' ); + ok( delete $error->[0]{'formatted'}, 'Got formatted message' ); + like( + delete $error->[0]{'message'}, + qr{^\QRoute exception: Cannot use content keyword outside delayed response\E}, + 'Correct error message', + ); + + is_deeply( + $error, + [ { level => 'error' } ], + 'Rest of error okay', + ); +}; diff --git a/t/dsl/delayed.t b/t/dsl/delayed.t new file mode 100644 index 00000000..8ad26ee9 --- /dev/null +++ b/t/dsl/delayed.t @@ -0,0 +1,161 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +eval { require AnyEvent; 1; } + or plan skip_all => 'AnyEvent required for this test'; + +plan tests => 5; + +{ + package App::Content; ## no critic + use Dancer2; + get '/' => sub { + ::is( $Dancer2::Core::Route::RESPONDER, undef, 'No responder yet' ); + + delayed { + ::isa_ok( + $Dancer2::Core::Route::RESPONDER, + 'CODE', + 'Got a responder in the delayed callback', + ); + + ::is( $Dancer2::Core::Route::WRITER, undef, 'No writer yet' ); + + content 'OK'; + ::ok( $Dancer2::Core::Route::WRITER, 'Got a writer' ); + + done; + }; + }; +} + +{ + package App::Content::MultiWrite; ## no critic + use Dancer2; + get '/' => sub { + delayed { + flush; + content 'Foo'; + content 'Bar'; + done; + }; + }; +} + +{ + package App::NoContent; ## no critic + use Dancer2; + get '/' => sub { + delayed {content;done;'Not OK'}; + }; +} + +{ + package App::MultipleContent; ## no critic + use Dancer2; + get '/' => sub { + delayed { + content 'Bar'; + done; + }; + return 'OK'; + }; +} + +my $caught_error; +{ + package App::ErrorHandler; ## no critic + use Dancer2; + require AnyEvent; + set logger => 'Capture'; + get '/log' => sub { + delayed { + flush; + content "ping\n"; + done; + content "failure\n"; + }; + }; + + get '/cb' => sub { + delayed { + flush; + content "ping\n"; + done; + content "failure\n"; + } on_error => sub { + $caught_error = shift; + }; + }; +} + +subtest 'Testing an app with content keyword' => sub { + my $test = Plack::Test->create( App::Content->to_app ); + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content, 'OK', 'Correct content' ); +}; + +subtest 'Testing an app with multiple content keyword calls' => sub { + my $test = Plack::Test->create( App::Content::MultiWrite->to_app ); + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content, 'FooBar', 'Correct content' ); +}; + +subtest 'Testing an app without content keyword' => sub { + my $test = Plack::Test->create( App::NoContent->to_app ); + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content, '', 'Correct content' ); +}; + +subtest 'Delayed response ignored for non-delayed content' => sub { + my $test = Plack::Test->create( App::MultipleContent->to_app ); + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content, 'OK', 'Correct content' ); +}; + +subtest 'Delayed response error handling' => sub { + my $test = Plack::Test->create( App::ErrorHandler->to_app ); + + TODO: { + local $TODO = 'Does not work in development server'; + + my $res = $test->request( GET '/log' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content, "ping\n", 'Correct content' ); + + my $logger = App::ErrorHandler::app->logger_engine; + my $logs = $logger->trapper->read; + isa_ok( $logs, 'ARRAY', 'Got logs' ); + is( scalar @{$logs}, 1, 'Got a message' ); + + my $msg = shift @{$logs}; + ok( $msg, 'Got message' ); + isa_ok( $msg, 'HASH', 'Got message' ); + is( + $msg->{'level'}, + 'core', + 'Correct error message level', + ); + + like( + $msg->{'message'}, + qr/^Error in delayed response:/, + 'Got error', + ); + } + + TODO: { + local $TODO = 'Does not work in development server'; + my $res = $test->request( GET '/cb' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content, "ping\n", 'Correct content' ); + like( $caught_error, qr/^Error in delayed response:/, 'Got error' ); + } +}; diff --git a/t/dsl/error_template.t b/t/dsl/error_template.t new file mode 100644 index 00000000..c583b518 --- /dev/null +++ b/t/dsl/error_template.t @@ -0,0 +1,78 @@ +use strict; +use warnings; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + package CustomError; + + use Dancer2; + + set views => 't/corpus/pretty'; + set public_dir => 't/corpus/pretty_public'; + + get '/error' => sub { + send_error "oh my", 505; + }; + + get '/public' => sub { + send_error "static", 510; + }; +} + +{ + package StandardError; + + use Dancer2; + set show_errors => 1; + + get '/no_template' => sub { + send_error "oopsie", 404; + }; +} + +my $custom_error_app = CustomError->to_app; +my $standard_error_app = StandardError->to_app; + +ok( is_coderef($custom_error_app), 'Got app' ); +ok( is_coderef($standard_error_app), 'Got app' ); + +my $custom_error_test = Plack::Test->create($custom_error_app); +my $standard_error_test = Plack::Test->create($standard_error_app); + +subtest "/error" => sub { + my $res = $custom_error_test->request( GET '/error' ); + + is $res->code, 505, 'send_error sets the status to 505'; + like $res->content, qr{Template selected}, 'Error message looks good'; + like $res->content, qr{message: oh my}; + like $res->content, qr{status: 505}; +}; + +subtest "/public" => sub { + my $res = $custom_error_test->request( GET '/public' ); + + is $res->code, 510, 'send_error sets the status to 510'; + like $res->content, qr{Static page}, 'Error message looks good'; +}; + +subtest '404 with static template' => sub { + my $res = $custom_error_test->request( GET '/middle/of/nowhere' ); + + is $res->code, 404, 'unknown route => 404'; + like $res->content, qr{you're lost}i, 'Error message looks good'; +}; + +subtest "/no_template" => sub { + my $res = $standard_error_test->request( GET '/no_template' ); + + is $res->code, 404, 'send_error sets the status to 404'; + like $res->content, qr{<h1>Error 404 - Not Found</h1>}, + 'Error message looks good'; + unlike $res->content, qr{Stack}, 'Error contains no stack trace'; +}; + +done_testing; diff --git a/t/dsl/extend.t b/t/dsl/extend.t new file mode 100644 index 00000000..abbb3178 --- /dev/null +++ b/t/dsl/extend.t @@ -0,0 +1,53 @@ +# define a sample DSL extension that will be used in the rest of these test +# This extends Dancer2::Core::DSL but provides an extra keyword +# +# Each test below creates a new package so it can load Dancer2 +BEGIN { + + package Dancer2::Test::ExtendedDSL; + + use Moo; + extends 'Dancer2::Core::DSL'; + + sub BUILD { + my ( $self ) = @_; + $self->register(foo => 1); + } + + sub foo { + return $_[1]; + } +} + +package main; + +use Test::More tests => 5; + +package test1; +use Test::More; + +use Dancer2 dsl => 'Dancer2::Test::ExtendedDSL'; + +ok(defined &foo, 'use line dsl can foo'); +is(foo('bar'), 'bar', 'use line Foo returns bar'); + +package test2; +use Test::More; + +ok(!defined &foo, 'intermediate package has no polluted namespace'); + +package test3; +use Test::More; +use FindBin; +use File::Spec; + +BEGIN { + $ENV{DANCER_CONFDIR} = File::Spec->catdir($FindBin::Bin, 'extend_config'); +} + +use Dancer2; + +ok(defined &foo, 'config specified DSL can foo'); +is(foo('baz'), 'baz', 'config specified Foo returns baz'); + +done_testing; diff --git a/t/dsl/extend_config/config.yml b/t/dsl/extend_config/config.yml new file mode 100644 index 00000000..da1f799b --- /dev/null +++ b/t/dsl/extend_config/config.yml @@ -0,0 +1 @@ +dsl_class: 'Dancer2::Test::ExtendedDSL' diff --git a/t/dsl/halt.t b/t/dsl/halt.t new file mode 100644 index 00000000..1e9e3ca8 --- /dev/null +++ b/t/dsl/halt.t @@ -0,0 +1,86 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +subtest 'halt within routes' => sub { + { + + package App; + use Dancer2; + + get '/' => sub { 'hello' }; + get '/halt' => sub { + response_header 'X-Foo' => 'foo'; + halt; + }; + get '/shortcircuit' => sub { + app->response->content('halted'); + halt; + redirect '/'; # won't get executed as halt returns immediately. + }; + } + + my $app = App->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + { + my $res = $cb->( GET '/shortcircuit' ); + is( $res->code, 200, '[/shortcircuit] Correct status' ); + is( $res->content, 'halted', '[/shortcircuit] Correct content' ); + + } + + { + my $res = $cb->( GET '/halt' ); + + is( + $res->server, + "Perl Dancer2 " . Dancer2->VERSION, + '[/halt] Correct Server header', + ); + + is( + $res->headers->header('X-Foo'), + 'foo', + '[/halt] Correct X-Foo header', + ); + } + }; + +}; + +subtest 'halt in before hook' => sub { + { + package App; + use Dancer2; + + hook before => sub { + response->content('I was halted'); + halt if request->path eq '/shortcircuit'; + }; + + } + + my $app = App->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/shortcircuit' ); + + is( $res->code, 200, '[/shortcircuit] Correct code with before hook' ); + is( + $res->content, + 'I was halted', + '[/shortcircuit] Correct content with before hook', + ); + }; +}; + +done_testing; diff --git a/t/dsl/halt_with_param.t b/t/dsl/halt_with_param.t new file mode 100644 index 00000000..ba9e4d3e --- /dev/null +++ b/t/dsl/halt_with_param.t @@ -0,0 +1,85 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +subtest 'halt with parameter within routes' => sub { + { + + package App; + use Dancer2; + + get '/' => sub { 'hello' }; + get '/halt' => sub { + response_header 'X-Foo' => 'foo'; + halt; + }; + get '/shortcircuit' => sub { + halt('halted'); + redirect '/'; # won't get executed as halt returns immediately. + }; + } + + my $app = App->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + { + my $res = $cb->( GET '/shortcircuit' ); + is( $res->code, 200, '[/shortcircuit] Correct status' ); + is( $res->content, 'halted', '[/shortcircuit] Correct content' ); + + } + + { + my $res = $cb->( GET '/halt' ); + + is( + $res->server, + "Perl Dancer2 " . Dancer2->VERSION, + '[/halt] Correct Server header', + ); + + is( + $res->headers->header('X-Foo'), + 'foo', + '[/halt] Correct X-Foo header', + ); + } + }; + +}; + +subtest 'halt with parameter in before hook' => sub { + { + package App; + use Dancer2; + + hook before => sub { + halt('I was halted') if request->path eq '/shortcircuit'; + }; + + } + + my $app = App->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/shortcircuit' ); + + is( $res->code, 200, '[/shortcircuit] Correct code with before hook' ); + is( + $res->content, + 'I was halted', + '[/shortcircuit] Correct content with before hook', + ); + }; +}; + +done_testing; + diff --git a/t/dsl/json.t b/t/dsl/json.t new file mode 100644 index 00000000..9f62e6b2 --- /dev/null +++ b/t/dsl/json.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + get '/' => sub { + my $app = app; + + my %test = (foo => 'bar'); + + ::is( encode_json(\%test), '{"foo":"bar"}', 'encode_json works' ); + ::is_deeply( decode_json(encode_json(\%test)), \%test, 'decode_json works' ); + }; +} + +Plack::Test->create( App->to_app )->request( GET '/' ); diff --git a/t/dsl/parameters.t b/t/dsl/parameters.t new file mode 100644 index 00000000..491071ff --- /dev/null +++ b/t/dsl/parameters.t @@ -0,0 +1,396 @@ +use strict; +use warnings; +use utf8; +use Test::More; +use Plack::Test; +use Encode 'encode_utf8'; +use HTTP::Request::Common; + +subtest 'Query parameters' => sub { + { + package App::Basic; ## no critic + use Dancer2; + get '/' => sub { + my $params = query_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword', + ); + + ::is( $params->get('foo'), 'bar', 'Got single value' ); + ::is( + $params->get('bar'), + 'quux', + 'Got single value from multi key', + ); + + ::is_deeply( + [ $params->get_all('bar') ], + ['baz', 'quux'], + 'Got multi value from multi key', + ); + + ::is( + $params->get('baz'), + 'הלו', + 'HMV interface returns encoded values', + ); + + ::is( + params->{'baz'}, + 'הלו', + 'Regular interface returns encoded values' + ); + }; + } + + my $app = Plack::Test->create( App::Basic->to_app ); + my $res = $app->request( GET '/?foo=bar&bar=baz&bar=quux&baz=הלו' ); + ok( $res->is_success, 'Successful request' ); +}; + +subtest 'Body parameters' => sub { + { + package App::Body; ## no critic + use Dancer2; + post '/' => sub { + my $params = body_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword', + ); + + ::is( $params->get('foo'), 'bar', 'Got single value' ); + ::is( + $params->get('bar'), + 'quux', + 'Got single value from multi key', + ); + + my $z = [ $params->get_all('bar') ]; + ::is_deeply( + [ $params->get_all('bar') ], + ['baz', 'quux'], + 'Got multi value from multi key', + ); + + ::is( + $params->get('baz'), + 'הלו', + 'HMV interface returns encoded values', + ); + + ::is( + params->{'baz'}, + 'הלו', + 'Regular interface returns encoded values' + ); + }; + } + + my $app = Plack::Test->create( App::Body->to_app ); + my $res = $app->request( + POST '/', + Content => [foo => 'bar', bar => 'baz', bar => 'quux', baz => 'הלו'] + ); + ok( $res->is_success, 'Successful request' ); +}; + +subtest 'Body parameters with serialized data' => sub { + { + package App::Body::JSON; ## no critic + use Dancer2; + set serializer => 'JSON'; + post '/' => sub { + my $params = body_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword', + ); + + ::is( $params->get('foo'), 'bar', 'Got single value' ); + ::is( + $params->get('bar'), + 'quux', + 'Got single value from multi key', + ); + + my $z = [ $params->get_all('bar') ]; + ::is_deeply( + [ $params->get_all('bar') ], + ['baz', 'quux'], + 'Got multi value from multi key', + ); + + ::is( + $params->get('baz'), + 'הלו', + 'HMV interface returns encoded values', + ); + + ::is( + params->{'baz'}, + 'הלו', + 'Regular interface returns encoded values' + ); + + return { ok => 1 }; + }; + } + + my $app = Plack::Test->create( App::Body::JSON->to_app ); + my $baz = encode_utf8('הלו'); + my $res = $app->request( + POST '/', Content => qq{{"foo":"bar","bar":["baz","quux"],"baz":"$baz"}} + ); + ok( $res->is_success, 'Successful request' ); +}; + +subtest 'Route parameters' => sub { + { + package App::Route; ## no critic + use Dancer2; + get '/:foo' => sub { + my $params = route_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword', + ); + + ::is( $params->get('foo'), 'bar', 'Got keyed value' ); + }; + + get '/:name/:value' => sub { + my $params = route_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword returns Hash::MultiValue object', + ); + + ::is( $params->get('name'), 'foo', 'Got first value' ); + ::is( $params->get('value'), 'הלו', 'Got second value' ); + ::is( + params->{'value'}, + 'הלו', + 'Regular interface returns encoded values' + ); + }; + } + + my $app = Plack::Test->create( App::Route->to_app ); + + { + my $res = $app->request( GET '/bar' ); + ok( $res->is_success, 'Successful request' ); + } + + { + my $res = $app->request( GET '/foo/הלו' ); + ok( $res->is_success, 'Successful request' ); + } +}; + +subtest 'Splat and megasplat route parameters' => sub { + { + package App::Route::Splat; ## no critic + use Dancer2; + get '/*' => sub { + my $params = route_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword', + ); + + ::is_deeply( + { %{$params} }, + {}, + 'All route parameters are empty', + ); + + ::is_deeply( + [ splat ], + [ 'foo' ], + 'Got splat values', + ); + }; + + get '/*/*' => sub { + my $params = route_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword returns Hash::MultiValue object', + ); + + + ::is_deeply( + { %{$params} }, + {}, + 'All route parameters are empty', + ); + + ::is_deeply( + [ splat ], + [ qw<foo bar> ], + 'Got splat values', + ); + }; + + # /foo/bar/baz/quux/quuks + get '/*/*/*/**' => sub { + my $params = route_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword returns Hash::MultiValue object', + ); + + + ::is_deeply( + { %{$params} }, + {}, + 'All route parameters are empty', + ); + + ::is_deeply( + [ splat ], + [ qw<foo bar baz>, [ qw<quux quuks> ] ], + 'Got splat values', + ); + }; + + # /foo/bar/baz + get '/*/:foo/**' => sub { + my $params = route_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword returns Hash::MultiValue object', + ); + + ::is( $params->get('foo'), 'bar', 'Correct route parameter' ); + + ::is_deeply( + [ splat ], + [ 'foo', ['baz', ''] ], + 'Got splat values', + ); + }; + } + + my $app = Plack::Test->create( App::Route::Splat->to_app ); + + { + my $res = $app->request( GET '/foo' ); + ok( $res->is_success, 'Successful request' ); + } + + { + my $res = $app->request( GET '/foo/bar' ); + ok( $res->is_success, 'Successful request' ); + } + + { + my $res = $app->request( GET '/foo/bar/baz/quux/quuks' ); + ok( $res->is_success, 'Successful request' ); + } + + { + my $res = $app->request( GET '/foo/bar/baz/' ); + ok( $res->is_success, 'Successful request' ); + } +}; + +subtest 'Captured route parameters' => sub { + { + package App::Route::Capture; ## no critic + use Dancer2; + get qr{^/foo/([^/]+)$} => sub { + my $params = route_parameters; + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword', + ); + + ::is_deeply( + { %{$params} }, + {}, + 'All route parameters are empty', + ); + + ::is_deeply( + [ splat ], + ['bar'], + 'Correct splat values', + ); + + ::is_deeply( + captures(), + +{}, + 'capture values are empty', + ); + }; + } + + my $app = Plack::Test->create( App::Route::Capture->to_app ); + + { + my $res = $app->request( GET '/foo/bar' ); + ok( $res->is_success, 'Successful request' ); + } +}; + +SKIP: { + Test::More::skip "named captures not available until 5.10", 1 + if !$^V or $^V lt v5.10; + + subtest 'Named captured route parameters' => sub { + { + package App::Route::NamedCapture; ## no critic + use Dancer2; + my $re = '^/bar/(?<baz>[^/]+)$'; + get qr{$re} => sub { + my $params = route_parameters; + + ::isa_ok( + $params, + 'Hash::MultiValue', + 'parameters keyword', + ); + + ::is_deeply( + { %{$params} }, + {}, + 'All route parameters are empty', + ); + + ::is_deeply( + [ splat ], + [], + 'splat values are empty', + ); + + ::is_deeply( + captures(), + { baz => 'quux' }, + 'Correct capture values', + ); + }; + } + + my $app = Plack::Test->create( App::Route::NamedCapture->to_app ); + + { + my $res = $app->request( GET '/bar/quux' ); + ok( $res->is_success, 'Successful request' ); + }; + }; +}; +done_testing(); diff --git a/t/dsl/pass.t b/t/dsl/pass.t new file mode 100644 index 00000000..9cd67391 --- /dev/null +++ b/t/dsl/pass.t @@ -0,0 +1,45 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +subtest 'pass within routes' => sub { + { + + package App; + use Dancer2; + + get '/' => sub { 'hello' }; + get '/**' => sub { + response_header 'X-Pass' => 'pass'; + pass; + redirect '/'; # won't get executed as pass returns immediately. + }; + get '/pass' => sub { + return "the baton"; + }; + } + + my $app = App->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + { + my $res = $cb->( GET '/pass' ); + is( $res->code, 200, '[/pass] Correct status' ); + is( $res->content, 'the baton', '[/pass] Correct content' ); + is( + $res->headers->header('X-Pass'), + 'pass', + '[/pass] Correct X-Pass header', + ); + } + }; + +}; + +done_testing; diff --git a/t/dsl/path.t b/t/dsl/path.t new file mode 100644 index 00000000..9a17db31 --- /dev/null +++ b/t/dsl/path.t @@ -0,0 +1,125 @@ +use strict; +use warnings; +use Test::More tests => 5; +use Plack::Test; +use Plack::Request; +use Plack::Builder; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + get '/' => sub { + my $dancer_req = request; + my $env = $dancer_req->env; + my $plack_req = Plack::Request->new($env); + + ::like( + $env->{'PATH_INFO'}, + qr{^/?$}, + 'PATH_INFO empty or /', + ); + + ::is( + $dancer_req->path_info, + $env->{'PATH_INFO'}, + 'D2 path_info matches $env', + ); + + ::is( + $dancer_req->path_info, + $plack_req->path_info, + 'D2 path_info matches Plack path_info', + ); + + ::is( $dancer_req->path, '/', 'D2 path is /' ); + ::is( $plack_req->path, '/', 'Plack path is /' ); + + return $dancer_req->script_name; + }; + + get '/endpoint' => sub { + my $dancer_req = request; + my $env = $dancer_req->env; + my $plack_req = Plack::Request->new($env); + + ::is( + $env->{'PATH_INFO'}, + '/endpoint', + 'PATH_INFO /endpoint', + ); + + ::is( + $dancer_req->path_info, + $env->{'PATH_INFO'}, + 'D2 path_info matches $env', + ); + + ::is( + $dancer_req->path_info, + $plack_req->path_info, + 'D2 path_info matches Plack path_info', + ); + + ::is( $dancer_req->path, '/endpoint', 'D2 path is /' ); + ::is( $plack_req->path, '/endpoint', 'Plack path is /' ); + + return $dancer_req->script_name; + }; +} + +subtest '/' => sub { + my $test = Plack::Test->create( App->to_app ); + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Result successful' ); + is( $res->content, '', 'script_name is empty' ); +}; + +subtest '/endpoint' => sub { + my $test = Plack::Test->create( App->to_app ); + my $res = $test->request( GET '/endpoint' ); + ok( $res->is_success, 'Result successful' ); + is( $res->content, '', 'script_name is empty' ); +}; + +subtest '/mounted/' => sub { + my $app = builder { + mount '/' => sub { [200,[],['OK']] }; + mount '/mounted' => App->to_app; + }; + + my $test = Plack::Test->create($app); + + my $res = $test->request( GET '/mounted/' ); + ok( $res->is_success, 'Result successful' ); + is( $res->content, '/mounted', 'script_name is /mounted' ); +}; + +subtest '/mounted/endpoint' => sub { + my $app = builder { + mount '/' => sub { [200,[],['OK']] }; + mount '/mounted' => App->to_app; + }; + + my $test = Plack::Test->create($app); + + my $res = $test->request( GET '/mounted/endpoint' ); + ok( $res->is_success, 'Result successful' ); + is( $res->content, '/mounted', 'script_name is /mounted' ); +}; + +# Tests behaviour when SCRIPT_NAME is also the beginning of PATH_INFO +# See the discussion in #1288. +subtest '/endpoint/endpoint' => sub { + my $app = builder { + mount '/' => sub { [200,[],['OK']] }; + mount '/endpoint' => App->to_app; + }; + + my $test = Plack::Test->create($app); + + my $res = $test->request( GET '/endpoint/endpoint' ); + ok( $res->is_success, 'Result successful' ); + is( $res->content, '/endpoint', 'script_name is /endpoint' ); +}; + diff --git a/t/dsl/request.t b/t/dsl/request.t new file mode 100644 index 00000000..b477f7a4 --- /dev/null +++ b/t/dsl/request.t @@ -0,0 +1,42 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App::DSL::Request; + use Dancer2; + + any [ 'get', 'post' ], '/' => sub { + request->method; + }; + + get 'headers' => sub { + request_header 'X-Foo'; + }; +} + +subtest 'Testing an app with request keyword' => sub { + my $test = Plack::Test->create( App::DSL::Request->to_app ); + { + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful GET request' ); + is( $res->content, 'GET', 'GET / correct content' ); + } + { + my $res = $test->request( POST '/' ); + ok( $res->is_success, 'Successful POST request' ); + is( $res->content, 'POST', 'POST / correct content' ); + } +}; + +subtest 'Testing app with request_header heyword' => sub { + my $test = Plack::Test->create( App::DSL::Request->to_app ); + my $res = $test->request( GET '/headers', 'X-Foo' => 'Bar' ); + ok( $res->is_success, 'Successful GET request' ); + is( $res->content, 'Bar', 'GET /headers correct content' ); +}; + +done_testing; + diff --git a/t/dsl/route_retvals.t b/t/dsl/route_retvals.t new file mode 100644 index 00000000..5c35d4a1 --- /dev/null +++ b/t/dsl/route_retvals.t @@ -0,0 +1,15 @@ +use strict; +use warnings; +use Dancer2; +use Test::More (); + +my @routes = get '/' => sub {1}; +Test::More::is( scalar @routes, 2, 'Two routes available' ); +foreach my $route (@routes) { + Test::More::isa_ok( $route, 'Dancer2::Core::Route' ); +} + +Test::More::is( $routes[0]->method, 'get', 'Created GET route' ); +Test::More::is( $routes[1]->method, 'head', 'Created HEAD route too' ); + +Test::More::done_testing; diff --git a/t/dsl/send_as.t b/t/dsl/send_as.t new file mode 100644 index 00000000..0aff1e67 --- /dev/null +++ b/t/dsl/send_as.t @@ -0,0 +1,161 @@ +use strict; +use warnings; + +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; + +{ + package DummyObj; + use Moo; + has foo => (is => 'ro', default => 'bar'); + sub TO_JSON { + {foo => shift->foo}; + } + 1; +} + +{ + package Test::App::SendAs; + use Dancer2; + + set engines => { + serializer => { + JSON => { + allow_blessed => 1, + convert_blessed => 1, + } + } + }; + set logger => 'Capture'; + set serializer => 'YAML'; + set template => 'TemplateToolkit'; + + get '/html' => sub { + send_as html => '<html></html>' + }; + + get '/plain' => sub { + send_as plain => 'some plain text with <html></html>'; + }; + + get '/json/**' => sub { + send_as JSON => splat; + }; + + get '/json-object' => sub { + send_as JSON => { data => DummyObj->new() }; + }; + + get '/json-utf8/**' => sub { + send_as JSON => splat, { content_type => 'application/json', charset => 'utf-8' }; + }; + + get '/yaml/**' => sub { + my @params = splat; + \@params; + }; + + get '/sendas/:type?' => sub { + send_as route_parameters->{'type'} => 'test string'; + }; +} + +my $test = Plack::Test->create( Test::App::SendAs->to_app ); + +subtest "default serializer" => sub { + my $res = $test->request( GET '/yaml/is/useful' ); + is $res->code, '200'; + is $res->content_type, 'text/x-yaml'; + + my $expected = <<'YAML'; +--- +- + - is + - useful +YAML + + is $res->content, $expected; + +}; + +subtest "send_as json" => sub { + my $res = $test->request( GET '/json/is/wonderful' ); + is $res->code, '200'; + is $res->content_type, 'application/json'; + + is $res->content, '["is","wonderful"]'; +}; + +subtest "send_as json object" => sub { + my $res = $test->request( GET '/json-object' ); + is $res->code, '200'; + is $res->content_type, 'application/json'; + + is $res->content, '{"data":{"foo":"bar"}}'; +}; + +subtest "send_as json custom content-type" => sub { + my $res = $test->request( GET '/json-utf8/is/wonderful' ); + is $res->code, '200'; + is $res->content_type, 'application/json'; + is $res->content_type_charset, 'UTF-8'; + + is $res->content, '["is","wonderful"]'; +}; + +subtest "send_as html" => sub { + my $res = $test->request( GET '/html' ); + is $res->code, '200'; + is $res->content_type, 'text/html'; + is $res->content_type_charset, 'UTF-8'; + + is $res->content, '<html></html>'; +}; + +subtest "send_as plain" => sub { + my $res = $test->request( GET '/plain' ); + is $res->code, '200'; + is $res->content_type, 'text/plain'; + is $res->content_type_charset, 'UTF-8'; + + is $res->content, 'some plain text with <html></html>'; +}; + +subtest "send_as error cases" => sub { + my $logger = Test::App::SendAs::app->logger_engine; + + { + my $res = $test->request( GET '/sendas/' ); + is $res->code, '500', "send_as dies with no defined type"; + + my $logs = $logger->trapper->read; + like $logs->[0]->{message}, + qr!Route exception: Can not send_as using an undefined type!, + ".. throws route exception"; + } + + { + my $res = $test->request( GET '/sendas/jSoN' ); + is $res->code, '500', + "send_as dies with incorrectly cased serializer name"; + + my $logs = $logger->trapper->read; + like $logs->[0]->{message}, + qr!Route exception: Unable to load serializer class for jSoN!, + ".. throws route exception"; + } + + { + my $res = $test->request( GET '/sendas/SomeSerializerThatDoesNotExist' ); + is $res->code, '500', + "send_as dies when called with non-existant serializer"; + + my $logs = $logger->trapper->read; + like $logs->[0]->{message}, + qr!Route exception: Unable to load serializer class for SomeSerializerThatDoesNotExist!, + ".. throws route exception"; + } +}; + +done_testing(); diff --git a/t/dsl/send_file.t b/t/dsl/send_file.t new file mode 100644 index 00000000..0ea2594b --- /dev/null +++ b/t/dsl/send_file.t @@ -0,0 +1,149 @@ +use strict; +use warnings; +use utf8; + +use Encode 'encode_utf8'; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use File::Temp; +use File::Spec; +use Ref::Util qw<is_coderef>; + +{ + package StaticContent; + + use Dancer2; + use Encode 'encode_utf8'; + + set views => 't/corpus/static'; + set public_dir => 't/corpus/static'; + + get '/' => sub { + send_file 'index.html'; + }; + + prefix '/some' => sub { + get '/image' => sub { + send_file '1x1.png'; + return "send_file returns; this content is ignored"; + }; + }; + + get '/stringref' => sub { + my $string = encode_utf8("This is əɯosəʍɐ an test string"); + send_file( \$string ); + }; + + get '/filehandle' => sub { + open my $fh, "<:raw", __FILE__; + send_file( $fh, content_type => 'text/plain', charset => 'utf-8' ); + }; + + get '/check_content_type' => sub { + my $temp = File::Temp->new(); + print $temp "hello"; + close $temp; + send_file($temp->filename, content_type => 'image/png', + system_path => 1); + }; + + get '/no_streaming' => sub { + my $file = File::Spec->rel2abs(__FILE__); + send_file( $file, system_path => 1, streaming => 0 ); + }; + + get '/options_streaming' => sub { + my $file = File::Spec->rel2abs(__FILE__); + send_file( $file, system_path => 1, streaming => 1 ); + }; + + get '/content_disposition/attachment' => sub { + send_file('1x1.png', filename => '1x1.png'); + }; + + get '/content_disposition/inline' => sub { + send_file('1x1.png', filename => '1x1.png', content_disposition => 'inline'); + }; +} + +my $app = StaticContent->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + subtest "Text content" => sub { + my $r = $cb->( GET '/' ); + + is( $r->code, 200, 'send_file sets the status to 200' ); + + my $charset = $r->headers->content_type_charset; + is( $charset, 'UTF-8', 'Text content type has UTF-8 charset' ); + my $test_string = encode_utf8('áéíóú'); + like( + $r->content, + qr{$test_string}, + 'Text content contains UTF-8 characters', + ); + }; + + subtest "Binary content" => sub { + my $r = $cb->( GET '/some/image' ); + + is( $r->code, 200, 'send_file sets the status to 200 (binary content)' ); + unlike( $r->content, qr/send_file returns/, + "send_file returns immediately with content"); + is( $r->header( 'Content-Type' ), 'image/png', + 'correct content_type in response' ); + }; + + subtest "string refs" => sub { + my $r = $cb->( GET '/stringref' ); + + is( $r->code, 200, 'send_file set status to 200 (string ref)'); + like( $r->content, qr{test string}, 'stringref content' ); + }; + + subtest "filehandles" => sub { + my $r = $cb->( GET '/filehandle' ); + + is( $r->code, 200, 'send_file set status to 200 (filehandle)'); + is( $r->content_type, 'text/plain', 'expected content_type'); + is( $r->content_type_charset, 'UTF-8', 'expected charset'); + like( $r->content, qr{package StaticContent}, 'filehandle content' ); + }; + + subtest "no streaming" => sub { + my $r = $cb->( GET '/no_streaming' ); + is( $r->code, 200, 'send_file set status to 200 (no streaming)'); + like( $r->content, qr{package StaticContent}, 'no streaming - content' ); + }; + + subtest "options streaming" => sub { + my $r = $cb->( GET '/options_streaming' ); + is( $r->code, 200, 'send_file set status to 200 (options streaming)'); + like( $r->content, qr{package StaticContent}, 'options streaming - content' ); + }; + + subtest 'send_file returns correct content type' => sub { + my $r = $cb->( GET '/check_content_type' ); + + ok($r->is_success, 'send_file returns success'); + is($r->content_type, 'image/png', 'send_file returns correct content_type'); + }; + + subtest 'Content-Disposition defaults to "attachment"' => sub { + my $r = $cb->( GET '/content_disposition/attachment' ); + ok($r->is_success, 'send_file returns success'); + is($r->header('Content-Disposition'), 'attachment; filename="1x1.png"', 'send_file returns correct attachment Content-Disposition'); + }; + + subtest 'Content-Disposition supports "inline"' => sub { + my $r = $cb->( GET '/content_disposition/inline' ); + ok($r->is_success, 'send_file returns success'); + is($r->header('Content-Disposition'), 'inline; filename="1x1.png"', 'send_file returns correct inline Content-Disposition'); + }; +}; + +done_testing; diff --git a/t/dsl/splat.t b/t/dsl/splat.t new file mode 100644 index 00000000..5a76c643 --- /dev/null +++ b/t/dsl/splat.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Test::More tests => 4; +use Plack::Test; +use HTTP::Request::Common; + +my @splat; + +{ + package App; + use Dancer2; + get '/*/*/*' => sub { + my $params = params(); + ::is_deeply( + $params, + { splat => [ qw<foo bar baz> ], foo => 42 }, + 'Correct params', + ); + + @splat = splat; + }; +} + +my $test = Plack::Test->create( App->to_app ); +my $res = $test->request( GET '/foo/bar/baz?foo=42' ); + +is_deeply( [@splat], [qw(foo bar baz)], 'splat behaves as expected' ); +is( $res->code, 200, 'got a 200' ); +is_deeply( $res->content, 3, 'got expected response' ); + diff --git a/t/dsl/to_app.t b/t/dsl/to_app.t new file mode 100644 index 00000000..47e01e94 --- /dev/null +++ b/t/dsl/to_app.t @@ -0,0 +1,31 @@ +use strict; +use warnings; +use Plack::Test; +use HTTP::Request::Common; +use Test::More tests => 2; + +{ + package App1; + use Dancer2; + get '/' => sub {'App1'}; + + my $app = to_app; + ::test_psgi $app, sub { + my $cb = shift; + ::is( $cb->( ::GET '/' )->content, 'App1', 'Got first App' ); + }; +} + +{ + package App2; + use Dancer2; + get '/' => sub {'App2'}; + + my $app = to_app; + ::test_psgi $app, sub { + my $cb = shift; + ::is( $cb->( ::GET '/' )->content, 'App2', 'Got second App' ); + }; +} + + diff --git a/t/engine.t b/t/engine.t new file mode 100644 index 00000000..c936338f --- /dev/null +++ b/t/engine.t @@ -0,0 +1,62 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Dancer2::Core::App; +use Dancer2::Template::Tiny; + +{ + my $f = Dancer2::Template::Tiny->new(); + isa_ok( $f, 'Dancer2::Template::Tiny' ); + ok( + $f->does('Dancer2::Core::Role::Engine'), + 'Consumed Role::Engine', + ); + + ok( + $f->does('Dancer2::Core::Role::Template'), + 'Consumed Role::Template', + ); + + is( $f->name, 'Tiny', 'Correct engine name' ); +} + +# checks for validity of engine names + +my $app = Dancer2::Core::App->new(); +isa_ok( $app, 'Dancer2::Core::App' ); + +{ + no warnings qw<redefine once>; + *Dancer2::Core::Factory::create = sub { $_[1] }; +} + +foreach my $engine_type ( qw<logger session template> ) { + note($engine_type); + my $engine; + my $build_method = "_build_${engine_type}_engine"; + + is( + exception { + $engine = $app->$build_method( + undef, { $engine_type => 'Fake43Thing' } + ); + }, + undef, + "Built $engine_type successfully with proper name", + ); + + like( + exception { + $engine = $app->$build_method( + undef, { $engine_type => '7&&afail' } + ); + }, + qr/^Cannot load $engine_type engine '7&&afail': illegal module name/, + "Failed creating $engine_type with illegal name", + ); + + is( $engine, $engine_type, 'Correct response from override' ); +} + +done_testing; diff --git a/t/error.t b/t/error.t new file mode 100644 index 00000000..6eca1190 --- /dev/null +++ b/t/error.t @@ -0,0 +1,264 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; +use List::Util qw<all>; + +use Dancer2::Core::App; +use Dancer2::Core::Response; +use Dancer2::Core::Request; +use Dancer2::Core::Error; + +use JSON::MaybeXS qw/JSON/; # Error serialization + +my $env = { + 'psgi.url_scheme' => 'http', + REQUEST_METHOD => 'GET', + SCRIPT_NAME => '/foo', + PATH_INFO => '/bar/baz', + REQUEST_URI => '/foo/bar/baz', + QUERY_STRING => 'foo=42&bar=12&bar=13&bar=14', + SERVER_NAME => 'localhost', + SERVER_PORT => 5000, + SERVER_PROTOCOL => 'HTTP/1.1', + REMOTE_ADDR => '127.0.0.1', + HTTP_COOKIE => + 'dancer.session=1234; fbs_102="access_token=xxxxxxxxxx%7Cffffff"', + HTTP_X_FORWARDED_FOR => '127.0.0.2', + REMOTE_HOST => 'localhost', + HTTP_USER_AGENT => 'Mozilla', + REMOTE_USER => 'sukria', +}; + +my $app = Dancer2::Core::App->new( name => 'main' ); +my $request = $app->build_request($env); + +$app->set_request($request); + +subtest 'basic defaults of Error object' => sub { + my $err = Dancer2::Core::Error->new( app => $app ); + is $err->status, 500, 'code'; + is $err->title, 'Error 500 - Internal Server Error', 'title'; + is $err->message, '', 'message'; + like $err->content, qr!http://localhost:5000/foo/css!, + "error content contains css path relative to uri_base"; +}; + +subtest "send_error in route" => sub { + { + + package App; + use Dancer2; + + set serializer => 'JSON'; + + get '/error' => sub { + send_error "This is a custom error message"; + return "send_error returns so this content is not processed"; + }; + } + + my $app = App->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + my $r = $cb->( GET '/error' ); + + is( $r->code, 500, 'send_error sets the status to 500' ); + like( + $r->content, + qr{This is a custom error message}, + 'Error message looks good', + ); + + is( + $r->content_type, + 'application/json', + 'Response has appropriate content type after serialization', + ); + }; +}; + +subtest "send_error with custom stuff" => sub { + { + + package App; + use Dancer2; + + get '/error/:x' => sub { + my $x = param('x'); + send_error "Error $x", "5$x"; + }; + } + + my $app = App->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + my $r = $cb->( GET '/error/42' ); + + is( $r->code, 542, 'send_error sets the status to 542' ); + like( $r->content, qr{Error 42}, 'Error message looks good' ); + }; +}; + +subtest 'Response->error()' => sub { + my $resp = Dancer2::Core::Response->new; + + isa_ok $resp->error( message => 'oops', status => 418 ), + 'Dancer2::Core::Error'; + + is $resp->status => 418, 'response code is 418'; + like $resp->content => qr/oops/, 'response content overriden by error'; + like $resp->content => qr/teapot/, 'error code title is present'; + ok $resp->is_halted, 'response is halted'; +}; + +subtest 'Throwing an error with a response' => sub { + my $resp = Dancer2::Core::Response->new; + + my $err = eval { Dancer2::Core::Error->new( + exception => 'our exception', + show_errors => 1 + )->throw($resp) }; + + isa_ok($err, 'Dancer2::Core::Response', "Error->throw() accepts a response"); +}; + +subtest 'Error with show_errors: 0' => sub { + my $err = Dancer2::Core::Error->new( + exception => 'our exception', + show_errors => 0 + )->throw; + unlike $err->content => qr/our exception/; +}; + +subtest 'Error with show_errors: 1' => sub { + my $err = Dancer2::Core::Error->new( + exception => 'our exception', + show_errors => 1 + )->throw; + like $err->content => qr/our exception/; +}; + +subtest 'App dies with serialized error' => sub { + { + package AppDies; + use Dancer2; + set serializer => 'JSON'; + + get '/die' => sub { + die "oh no\n"; # I should serialize + }; + } + + my $app = AppDies->to_app; + isa_ok( $app, 'CODE', 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + my $r = $cb->( GET '/die' ); + + is( $r->code, 500, '/die returns 500' ); + + my $out = eval { JSON->new->utf8(0)->decode($r->decoded_content) }; + ok(!$@, 'JSON decoding serializer error produces no errors'); + isa_ok($out, 'HASH', 'Error deserializes to a hash'); + like($out->{exception}, qr/^oh no/, 'Get expected error message'); + }; +}; + +subtest 'Error with exception object' => sub { + local $@; + eval { MyTestException->throw('a test exception object') }; + my $err = Dancer2::Core::Error->new( + exception => $@, + show_errors => 1, + )->throw; + + like $err->content, qr/a test exception object/, 'Error content contains exception message'; +}; + +subtest 'Errors without server tokens' => sub { + { + package AppNoServerTokens; + use Dancer2; + set serializer => 'JSON'; + set no_server_tokens => 1; + + get '/ohno' => sub { + die "oh no"; + }; + } + + my $test = Plack::Test->create( AppNoServerTokens->to_app ); + my $r = $test->request( GET '/ohno' ); + is( $r->code, 500, "/ohno returned 500 response"); + is( $r->header('server'), undef, "No server header when no_server_tokens => 1" ); +}; + +subtest 'Errors with show_errors and circular references' => sub { + { + package App::ShowErrorsCircRef; + use Dancer2; + set show_errors => 1; + set something_with_config => {something => config}; + set password => '===VERY-UNIQUE-STRING==='; + set innocent_thing => '===VERY-INNOCENT-STRING==='; + set template => 'simple'; + + # Trigger an error that makes Dancer2::Core::Error::_censor enter an + # infinite loop + get '/ohno' => sub { + template q{I don't exist}; + }; + + } + + my $test = Plack::Test->create( App::ShowErrorsCircRef->to_app ); + my $r = $test->request( GET '/ohno' ); + is( $r->code, 500, "/ohno returned 500 response"); + like( $r->content, qr{Stack}, 'it includes a stack trace' ); + + my @password_values = ($r->content =~ /\bpassword\b(.+)\n/g); + my $is_password_hidden = + all { /Hidden \(looks potentially sensitive\)/ } @password_values; + + ok($is_password_hidden, "password was hidden in stacktrace"); + + cmp_ok(@password_values, '>', 1, + 'password key appears more than once in the stacktrace'); + + unlike($r->content, qr{===VERY-UNIQUE-STRING===}, + 'password value does not appear in the stacktrace'); + + like($r->content, qr{===VERY-INNOCENT-STRING===}, + 'Values for other keys (non-sensitive) appear in the stacktrace'); +}; + +done_testing; + + +{ # Simple test exception class + package MyTestException; + + use overload '""' => \&as_str; + + sub new { + return bless {}; + } + + sub throw { + my ( $class, $error ) = @_; + my $self = ref($class) ? $class : $class->new; + $self->{error} = $error; + + die $self; + } + + sub as_str { return $_[0]->{error} } +} diff --git a/t/examples/hello_world.t b/t/examples/hello_world.t new file mode 100644 index 00000000..85929fe9 --- /dev/null +++ b/t/examples/hello_world.t @@ -0,0 +1,18 @@ +use strict; +use warnings; + +use FindBin (); + +use Test::More tests => 3; +use Plack::Test; +use HTTP::Request::Common qw(GET); + +my $app = do "$FindBin::Bin/../../examples/single/hello_world.psgi"; +is( ref $app, 'CODE', 'Got app' ); + +my $test = Plack::Test->create($app); + +my $res = $test->request( GET '/' ); +ok( $res->is_success, '[GET /] successful' ); +is( $res->content, 'Hello World', 'Content looks ok' ); + diff --git a/t/examples/simple_calculator.t b/t/examples/simple_calculator.t new file mode 100644 index 00000000..642acd1a --- /dev/null +++ b/t/examples/simple_calculator.t @@ -0,0 +1,41 @@ +use strict; +use warnings; + +use FindBin (); + +use Test::More; +use Plack::Test; +use HTTP::Request::Common qw(GET POST); + +my $app = do "$FindBin::Bin/../../examples/single/simple_calculator.psgi"; +is( ref $app, 'CODE', 'Got app' ); + +my $test = Plack::Test->create($app); + +my $res = $test->request( GET '/' ); +ok( $res->is_success, '[GET /] successful' ); +like( $res->content, qr/powered by Dancer/, 'Content looks ok' ); + +subtest add => sub { + plan tests => 2; + my $res = $test->request( GET '/add/19/23' ); + ok( $res->is_success, '[GET /add/] successful' ); + is( $res->content, 42, 'Content looks ok' ); +}; + +subtest multiply => sub { + plan tests => 2; + my $res = $test->request( GET '/multiply?x=10&y=5' ); + ok( $res->is_success, '[GET /multiply/] successful' ); + is( $res->content, 50, 'Content looks ok' ); +}; + +subtest division => sub { + plan tests => 2; + my $res = $test->request( POST '/division', { x=>10, y=>5 } ); + ok( $res->is_success, '[GET /division/] successful' ); + is( $res->content, 2, 'Content looks ok' ); +}; + +done_testing(); + diff --git a/t/factory.t b/t/factory.t new file mode 100644 index 00000000..eab8828f --- /dev/null +++ b/t/factory.t @@ -0,0 +1,21 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Dancer2::Core; +use Dancer2::Core::Factory; + +is Dancer2::Core::camelize('foo_bar_baz'), 'FooBarBaz'; +is Dancer2::Core::camelize('FooBarBaz'), 'FooBarBaz'; + +like( + exception { my $l = Dancer2::Core::Factory->create( unknown => 'stuff' ) }, + qr{Unable to load class for Unknown component Stuff:}, + 'Failure to load nonexistent class', +); + +my $l = Dancer2::Core::Factory->create( logger => 'console' ); +isa_ok $l, 'Dancer2::Logger::Console'; + +done_testing; diff --git a/t/file_utils.t b/t/file_utils.t new file mode 100644 index 00000000..bb94efe6 --- /dev/null +++ b/t/file_utils.t @@ -0,0 +1,93 @@ +use strict; +use warnings; +use utf8; + +use Test::More tests => 25; +use Test::Fatal; +use File::Spec; +BEGIN { @File::Spec::ISA = ("File::Spec::Unix") } +use File::Temp 0.22; + +use Dancer2::FileUtils qw/read_file_content path_or_empty path/; + +sub write_file { + my ( $file, $content ) = @_; + + open my $fh, '>', $file or die "cannot write file $file : $!"; + binmode $fh, ':encoding(utf-8)'; + print $fh $content; + close $fh; +} + +sub hexe { + my $s = shift; + $s =~ s/([\x00-\x1F])/sprintf('%#x',ord($1))/eg; + return $s; +} + +like( + exception { Dancer2::FileUtils::open_file( '<', '/slfkjsdlkfjsdlf' ) }, + qr{/slfkjsdlkfjsdlf' using mode '<': \w+}, + 'Failure opening nonexistent file', +); + +my $content = Dancer2::FileUtils::read_file_content(); +is $content, undef; + +my $paths = [ + [ undef => 'undef' ], + [ '/foo/./bar/' => '/foo/bar/' ], + [ '/foo/../bar' => '/bar' ], + [ '/foo/bar/..' => '/foo/' ], + [ '/a/b/c/d/A/B/C' => '/a/b/c/d/A/B/C' ], + [ '/a/b/c/d/../A/B/C' => '/a/b/c/A/B/C' ], + [ '/a/b/c/d/../../A/B/C' => '/a/b/A/B/C' ], + [ '/a/b/c/d/../../../A/B/C' => '/a/A/B/C' ], + [ '/a/b/c/d/../../../../A/B/C' => '/A/B/C' ], +]; + +for my $case ( @$paths ) { + is Dancer2::FileUtils::normalize_path( $case->[0] ), $case->[1]; +} + +my $p = Dancer2::FileUtils::dirname('/somewhere'); +is $p, '/'; + +my $tmp = File::Temp->new(); +my $two = "²❷"; +write_file( $tmp, "one$/$two" ); + +$content = read_file_content($tmp); +is hexe($content), hexe("one$/$two"); + +my @content = read_file_content($tmp); +is hexe( $content[0] ), hexe("one$/"); +is $content[1], "$two"; + +# returns UNDEF on non-existant path +my $path = 'bla/blah'; +if ( !-e $path ) { + is( path_or_empty($path), '', 'path_or_empty on non-existent path', ); +} + +my $tmpdir = File::Temp->newdir; +is( path_or_empty($tmpdir), $tmpdir, 'path_or_empty on an existing path' ); + +#slightly tricky paths on different platforms +is( path( '/', 'b', '/c' ), '/b//c', 'path /,b,/c -> /b//c' ); +is( path( '/', '/b', ), '/b', 'path /, /b -> /b' ); + +note "escape_filename"; { + my $names = [ + [ undef => 'undef' ], + [ 'abcdef' => 'abcdef' ], + [ 'ab++ef' => 'ab+2b+2bef' ], + [ 'a/../b.txt' => 'a+2f+2e+2e+2fb+2etxt' ], + [ "test\0\0" => 'test+00+00' ], + [ 'test☠☠☠' => 'test+2620+2620+2620' ], + ]; + + for my $case ( @$names ) { + is Dancer2::FileUtils::escape_filename( $case->[0] ), $case->[1]; + } +} diff --git a/t/forward.t b/t/forward.t new file mode 100644 index 00000000..d12da8a7 --- /dev/null +++ b/t/forward.t @@ -0,0 +1,183 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +use Dancer2; + +set behind_proxy => 1; + +get '/' => sub { + 'home:' . join( ',', params ); +}; +get '/bounce/' => sub { + return forward '/'; +}; +get '/bounce/:withparams/' => sub { + return forward '/'; +}; +get '/bounce2/adding_params/' => sub { + return forward '/', { withparams => 'foo' }; +}; +post '/simple_post_route/' => sub { + 'post:' . join( ',', params ); +}; +get '/go_to_post/' => sub { + return forward '/simple_post_route/', { foo => 'bar' }, + { method => 'post' }; +}; +get '/proxy/' => sub { + return uri_for('/'); +}; +get '/forward_with_proxy/' => sub { + forward '/proxy/'; +}; + +# NOT SUPPORTED IN DANCER2 +# In dancer2, vars are alive for only one request flow, a forward initiate a +# new request flow, then the vars HashRef is destroyed. +# +# get '/b' => sub { vars->{test} = 1; forward '/a'; }; +# get '/a' => sub { return "test is " . var('test'); }; + +my $app = __PACKAGE__->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + is( $cb->( GET '/' )->code, 200, '[GET /] Correct code' ); + is( $cb->( GET '/' )->content, 'home:', '[GET /] Correct content' ); + + is( $cb->( GET '/bounce/' )->code, 200, '[GET /bounce] Correct code' ); + is( + $cb->( GET '/bounce/' )->content, + 'home:', + '[GET /bounce] Correct content', + ); + + is( + $cb->( GET '/bounce/thesethings/' )->code, + 200, + '[GET /bounce/thesethings/] Correct code', + ); + + is( + $cb->( GET '/bounce/thesethings/' )->content, + 'home:withparams,thesethings', + '[GET /bounce/thesethings/] Correct content', + ); + + is( + $cb->( GET '/bounce2/adding_params/' )->code, + 200, + '[GET /bounce2/adding_params/] Correct code', + ); + + is( + $cb->( GET '/bounce2/adding_params/' )->content, + 'home:withparams,foo', + '[GET /bounce2/adding_params/] Correct content', + ); + + is( + $cb->( GET '/go_to_post/' )->code, + 200, + '[GET /go_to_post/] Correct code', + ); + + is( + $cb->( GET '/go_to_post/' )->content, + 'post:foo,bar', + '[GET /go_to_post/] Correct content', + ); + + # NOT SUPPORTED + # response_status_is [ GET => '/b' ] => 200; + # response_content_is [ GET => '/b' ] => 'test is 1'; + + { + my $res = $cb->( GET '/bounce/' ); + + is( + $res->headers->content_length, + 5, + '[GET /bounce/] Correct content length', + ); + + is( + $res->headers->content_type, + 'text/html', + '[GET /bounce/] Correct content type', + ); + + is( + $res->headers->content_type_charset, + 'UTF-8', + '[GET /bounce/] Correct content type charset', + ); + + is( + $res->headers->server, + "Perl Dancer2 " . Dancer2->VERSION, + '[GET /bounce/] Correct Server', + ); + + } + + # checking post + post '/' => sub {'post-home'}; + post '/bounce/' => sub { forward('/') }; + + is( $cb->( POST '/' )->code, 200, '[POST /] Correct code' ); + is( $cb->( POST '/' )->content, 'post-home', '[POST /] Correct content' ); + + is( + $cb->( POST '/bounce/' )->code, + 200, + '[POST /bounce/] Correct code', + ); + + is( + $cb->( POST '/bounce/' )->content, + 'post-home', + '[POST /bounce/] Correct content', + ); + + { + my $res = $cb->( POST '/bounce/' ); + + is( + $res->headers->content_length, + 9, + '[POST /bounce/] Correct content length', + ); + + is( + $res->headers->content_type, + 'text/html', + '[POST /bounce/] Correct content type', + ); + + is( + $res->headers->content_type_charset, + 'UTF-8', + '[POST /bounce/] Correct content type charset', + ); + + is( + $res->headers->server, + "Perl Dancer2 " . Dancer2->VERSION, + '[POST /bounce/] Correct Server', + ); + } + + is( + $cb->( GET '/forward_with_proxy/', 'X-Forwarded-Proto' => 'https' )->content, + 'https://localhost/', + '[GET /forward_with_proxy/] maintained is_behind_proxy', + ); +}; + +done_testing; diff --git a/t/forward_before_hook.t b/t/forward_before_hook.t new file mode 100644 index 00000000..1f516fca --- /dev/null +++ b/t/forward_before_hook.t @@ -0,0 +1,58 @@ +use strict; +use warnings; +use Test::More import => ['!pass'], tests => 4; +use Dancer2; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +get '/' => sub { + return 'Forbidden'; +}; + +get '/default' => sub { + return 'Default'; +}; + +get '/redirect' => sub { + return 'Secret stuff never seen'; +}; + +hook before => sub { + return if request->path eq '/default'; + + # Add some content to the response + response->content("SillyStringIsSilly"); + + # redirect - response should include the above content + return redirect '/default' + if request->path eq '/redirect'; + + # The response object will get replaced by the result of the forward. + forward '/default'; +}; + +my $app = __PACKAGE__->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + like( + $cb->( GET '/' )->content, + qr{Default}, + 'forward in before hook', + ); + + my $r = $cb->( GET '/redirect' ); + + # redirect in before hook + is( $r->code, 302, 'redirect in before hook' ); + is( + $r->content, + 'SillyStringIsSilly', + '.. and the response content is correct', + ); +}; + +done_testing(); diff --git a/t/forward_hmv_params.t b/t/forward_hmv_params.t new file mode 100644 index 00000000..42449086 --- /dev/null +++ b/t/forward_hmv_params.t @@ -0,0 +1,57 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; + +use utf8; +use Encode qw(); + +{ + package Test::Forward::HMV; + use Dancer2; + + any '/' => sub { + 'home:' . join( ',', request->parameters->flatten ); + }; + + get '/get' => sub { + forward '/', { get => 'bâz' }; + }; + + post '/post' => sub { + forward '/', { post => 'bâz' }; + }; + + post '/change/:me' => sub { + forward '/', { post => route_parameters->get('me') }, { method => 'GET' }; + }; +} + +my $test = Plack::Test->create( Test::Forward::HMV->to_app ); + +subtest 'query parameters (#1245)' => sub { + my $res = $test->request( GET '/get?foo=bâr' ); + is $res->code, 200, "success forward for /get"; + my $content = Encode::decode( 'UTF-8', $res->content ); + is $content, 'home:foo,bâr,get,bâz', "query parameters merged after forward"; +}; + +subtest 'body parameters (#1116)' => sub { + my $res = $test->request( POST '/post', { foo => 'bâr' } ); + is $res->code, 200, "success forward for /post"; + # The order is important: post,baz are QUERY params + # foo,bar are the original body params + my $content = Encode::decode( 'UTF-8', $res->content ); + like $content, qr/^home:post,bâz/, "forward params become query params"; + is $content, 'home:post,bâz,foo,bâr', "body parameters available after forward"; +}; + +subtest 'params when method changes' => sub { + my $res = $test->request( POST '/change/1234', { foo => 'bâr' } ); + is $res->code, 200, "success forward for /change/:me"; + my $content = Encode::decode( 'UTF-8', $res->content ); + is $content, 'home:post,1234,foo,bâr', "body parameters available after forward"; +}; + +done_testing(); diff --git a/t/forward_test_tcp.t b/t/forward_test_tcp.t new file mode 100644 index 00000000..52a85a89 --- /dev/null +++ b/t/forward_test_tcp.t @@ -0,0 +1,82 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + package App; + use Dancer2; + + get '/' => sub { + 'home:' . join( ',', params ); + }; + + get '/bounce/' => sub { forward '/' }; + + get '/bounce/:withparams/' => sub { forward '/' }; + + get '/bounce2/adding_params/' => sub { + forward '/', { withparams => 'foo' }; + }; + + get '/go_to_post/' => sub { + forward '/simple_post_route/', + { foo => 'bar' }, + { method => 'post' }; + }; + + post '/simple_post_route/' => sub { + 'post:' . join( ',', params ); + }; + + post '/' => sub {'post-home'}; + + post '/bounce/' => sub { forward '/' }; +} + +my $app = Dancer2->psgi_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + my $res = $cb->(GET "/"); + is $res->code => 200; + like $res->content => qr/home:/; + + $res = $cb->(GET "/bounce/"); + is $res->code => 200; + like $res->content => qr/home:/; + + $res = $cb->(GET "/bounce/thesethings/"); + is $res->code => 200; + is $res->content => 'home:withparams,thesethings'; + + $res = $cb->(GET "/bounce2/adding_params/"); + is $res->code => 200; + is $res->content => 'home:withparams,foo'; + + $res = $cb->(GET "/go_to_post/"); + is $res->code => 200; + is $res->content => 'post:foo,bar'; + + $res = $cb->(GET "/bounce/"); + is $res->header('Content-Length') => 5; + is $res->header('Content-Type') => 'text/html; charset=UTF-8'; + is $res->header('Server') => "Perl Dancer2 " . Dancer2->VERSION; + + $res = $cb->(POST "/"); + is $res->code => 200; + is $res->content => 'post-home'; + + $res = $cb->(POST "/bounce/"); + is $res->code => 200; + is $res->content => 'post-home'; + is $res->header('Content-Length') => 9; + is $res->header('Content-Type') => 'text/html; charset=UTF-8'; + is $res->header('Server') => "Perl Dancer2 " . Dancer2->VERSION; +}; + +done_testing(); diff --git a/t/hooks.t b/t/hooks.t new file mode 100644 index 00000000..498a8255 --- /dev/null +++ b/t/hooks.t @@ -0,0 +1,237 @@ +use strict; +use warnings; +use Test::More; +use File::Spec; +use Plack::Test; +use HTTP::Request::Common; +use Capture::Tiny 0.12 'capture_stderr'; +use JSON::MaybeXS; + +eval { require Template; 1; } + or plan skip_all => 'Template::Toolkit not present'; + +my $tests_flags = {}; + +{ + package App::WithSerializer; + use Dancer2; + use Ref::Util qw<is_arrayref is_hashref>; + + set serializer => 'JSON'; + + my @hooks = qw( + before_request + after_request + + before_serializer + after_serializer + ); + + for my $hook (@hooks) { + hook $hook => sub { + $tests_flags->{$hook} ||= 0; + $tests_flags->{$hook}++; + }; + } + + get '/' => sub { +{ "ok" => 1 } }; + + hook 'before_serializer' => sub { + my ($data) = @_; # don't shift, want to alias.. + if ( is_arrayref($data) ) { + push( @{$data}, ( added_in_hook => 1 ) ); + } elsif ( is_hashref($data) ) { + $data->{'added_in_hook'} = 1; + } else { + $_[0] = +{ 'added_in_hook' => 1 }; + } + }; + + get '/forward' => sub { Test::More::note 'About to forward!'; forward '/' }; + + get '/redirect' => sub { redirect '/' }; + + get '/json' => sub { +[ foo => 42 ] }; + + get '/nothing' => sub { return }; +} + +{ + package App::WithFile; + use Dancer2; + my @hooks = qw< + before_file_render + after_file_render + >; + + for my $hook (@hooks) { + hook $hook => sub { + $tests_flags->{$hook} ||= 0; + $tests_flags->{$hook}++; + }; + } + + get '/send_file' => sub { + send_file( File::Spec->rel2abs(__FILE__), system_path => 1 ); + }; +} + +{ + package App::WithTemplate; + use Dancer2; + set template => 'tiny'; + + my @hooks = qw( + before_template_render + after_template_render + ); + + for my $hook (@hooks) { + hook $hook => sub { + $tests_flags->{$hook} ||= 0; + $tests_flags->{$hook}++; + }; + } + + get '/template' => sub { + template \"PLOP"; + }; +} + +{ + package App::WithIntercept; + use Dancer2; + + get '/intercepted' => sub {'not intercepted'}; + + hook before => sub { + response->content('halted by before'); + halt; + }; +} + +{ + package App::WithError; + use Dancer2; + + my @hooks = qw( + on_route_exception + ); + + for my $hook (@hooks) { + hook $hook => sub { + $tests_flags->{$hook} ||= 0; + $tests_flags->{$hook}++; + }; + } + + get '/route_exception' => sub {die 'this is a route exception'}; + + hook after => sub { + # GH#540 - ensure setting default scalar does not + # interfere with hook execution (aliasing) + $_ = 42; + }; + + hook on_route_exception => sub { + my ($app, $error) = @_; + ::is ref($app), 'Dancer2::Core::App'; + ::like $error, qr/this is a route exception/; + }; + + hook init_error => sub { + my ($error) = @_; + ::is ref($error), 'Dancer2::Core::Error'; + }; + + hook before_error => sub { + my ($error) = @_; + ::is ref($error), 'Dancer2::Core::Error'; + }; + + hook after_error => sub { + my ($response) = @_; + ::is ref($response), 'Dancer2::Core::Response'; + ::ok !$response->is_halted; + ::like $response->content, qr/Internal Server Error/; + }; +} + +subtest 'Request hooks' => sub { + my $test = Plack::Test->create( App::WithSerializer->to_app ); + $test->request( GET '/' ); + + is( $tests_flags->{before_request}, 1, "before_request was called" ); + is( $tests_flags->{after_request}, 1, "after_request was called" ); + is( $tests_flags->{before_serializer}, 1, "before_serializer was called" ); + is( $tests_flags->{after_serializer}, 1, "after_serializer was called" ); + is( $tests_flags->{before_file_render}, undef, "before_file_render undef" ); + + note 'after hook called once per request'; + # Get current value of the 'after_request' tests flag. + my $current = $tests_flags->{after_request}; + + $test->request( GET '/redirect' ); + is( + $tests_flags->{after_request}, + ++$current, + "after_request called after redirect", + ); + + note 'Serializer hooks'; + + $test->request( GET '/forward' ); + is( + $tests_flags->{after_request}, + ++$current, + "after_request called only once after forward", + ); + + my $res = $test->request( GET '/json' ); + is( $res->content, '["foo",42,"added_in_hook",1]', 'Response serialized' ); + is( $tests_flags->{before_serializer}, 4, 'before_serializer was called' ); + is( $tests_flags->{after_serializer}, 4, 'after_serializer was called' ); + is( $tests_flags->{before_file_render}, undef, "before_file_render undef" ); + + $res = $test->request( GET '/nothing' ); + is( $res->content, '{"added_in_hook":1}', 'Before hook modified content' ); + is( $tests_flags->{before_serializer}, 5, 'before_serializer was called with no content' ); + is( $tests_flags->{after_serializer}, 5, 'after_serializer was called after content changes in hook' ); +}; + +subtest 'file render hooks' => sub { + my $test = Plack::Test->create( App::WithFile->to_app ); + $test->request( GET '/send_file' ); + is( $tests_flags->{before_file_render}, 1, "before_file_render was called" ); + is( $tests_flags->{after_file_render}, 1, "after_file_render was called" ); +}; + +subtest 'template render hook' => sub { + my $test = Plack::Test->create( App::WithTemplate->to_app ); + + $test->request( GET '/template' ); + is( + $tests_flags->{before_template_render}, + 1, + "before_template_render was called", + ); + + is( + $tests_flags->{after_template_render}, + 1, + "after_template_render was called", + ); +}; + +subtest 'before can halt' => sub { + my $test = Plack::Test->create( App::WithIntercept->to_app ); + my $resp = $test->request( GET '/intercepted' ); + is( $resp->content, 'halted by before' ); +}; + +subtest 'route_exception' => sub { + my $test = Plack::Test->create( App::WithError->to_app ); + capture_stderr { $test->request( GET '/route_exception' ) }; +}; + +done_testing; diff --git a/t/http_methods.t b/t/http_methods.t new file mode 100644 index 00000000..9a890a69 --- /dev/null +++ b/t/http_methods.t @@ -0,0 +1,49 @@ +use strict; +use warnings; + +use Test::More tests => 12; +use Plack::Test; +use HTTP::Request; +use Ref::Util qw<is_coderef>; + +use Dancer2; + +my %method = ( + get => 'GET', + post => 'POST', + del => 'DELETE', + patch => 'PATCH', + put => 'PUT', + options => 'OPTIONS', +); + +my $app = __PACKAGE__->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + while ( my ( $method, $http ) = each %method ) { + eval "$method '/' => sub { '$method' }"; + is( + $cb->( HTTP::Request->new( $http => '/' ) )->content, + $method, + "$http /", + ); + } + + eval "get '/head' => sub {'HEAD'}"; + + my $res = $cb->( HTTP::Request->new( HEAD => '/head' ) ); + is( $res->content, '', 'HEAD /' ); # HEAD requests have no content + is( $res->headers->content_length, 4, 'Content-Length for HEAD' ); + + # Testing invalid HTTP methods. + { + my $req = HTTP::Request->new( "ILLEGAL" => '/' ); + my $res = $cb->( $req ); + ok( !$res->is_success, "Response->is_success is false when using illegal HTTP method" ); + is( $res->code, 405, "Illegal method should return 405 code" ); + like( $res->content, qr<Method Not Allowed>, q<Illegal method should have "Method Not Allowed" in the content> ); + } +}; diff --git a/t/http_status.t b/t/http_status.t new file mode 100644 index 00000000..a9791125 --- /dev/null +++ b/t/http_status.t @@ -0,0 +1,41 @@ +use strict; +use warnings; +use Test::More tests => 5; + +use Dancer2::Core::HTTP; + +subtest "HTTP status" => sub { + is( Dancer2::Core::HTTP->status( $_->{status} ) => $_->{expected}, + 'status: '. ( $_->{status} || 'undef' ) ) + for { status => undef, expected => undef }, + { status => 200, expected => 200 }, + { status => 'Not Found', expected => 404 }, + { status => 'bad_request', expected => 400 }, + { status => 'i_m_a_teapot', expected => 418 }, + { status => 'error', expected => 500 }, + { status => 911, expected => 911 }; +}; + + +subtest "HTTP status_message" => sub { + is( Dancer2::Core::HTTP->status_message( $_->{status} ) => $_->{expected}, + 'status: '. ( $_->{status} || 'undef' ) ) + for { status => undef, expected => undef }, + { status => 200, expected => 'OK' }, + { status => 'error', expected => 'Internal Server Error' }, + { status => 911, expected => undef }; +}; + +is { Dancer2::Core::HTTP->status_mapping }->{"I'm a teapot"} + => 418, 'status_mapping'; + +is { Dancer2::Core::HTTP->code_mapping }->{418} + => "I'm a teapot", 'code_mapping'; + +subtest 'all_mappings' => sub { + my %mappings = Dancer2::Core::HTTP->all_mappings; + + is $mappings{"I'm a teapot"} => 418; + is $mappings{"i_m_a_teapot"} => 418; + is $mappings{418} => "I'm a teapot"; +}; diff --git a/t/issues/config.yml b/t/issues/config.yml new file mode 100644 index 00000000..a512f360 --- /dev/null +++ b/t/issues/config.yml @@ -0,0 +1 @@ +logger: "Note" diff --git a/t/issues/gh-1013/gh-1013.t b/t/issues/gh-1013/gh-1013.t new file mode 100644 index 00000000..29298640 --- /dev/null +++ b/t/issues/gh-1013/gh-1013.t @@ -0,0 +1,39 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Plack::Test; +use HTTP::Request::Common; + +{ + ## no critic + package TestApp; + use Dancer2; + + my $app = app; + hook before_template => sub { + 1; + }; + + set template => 'simple'; + + get '/' => sub { + template t => { hi => 'hello' }, + }; +}; + +my $test = Plack::Test->create( TestApp->to_app ); + +my $res; +is( + exception { $res = $test->request( GET '/' ); }, + undef, + 'Request does not crash', +); + +ok( $res->is_success, 'Request successful' ); + +chomp( my $content = $res->content ); +is( $content, 'hello', 'Correct content' ); + +done_testing; diff --git a/t/issues/gh-1013/views/t.tt b/t/issues/gh-1013/views/t.tt new file mode 100644 index 00000000..f6f3c2ca --- /dev/null +++ b/t/issues/gh-1013/views/t.tt @@ -0,0 +1 @@ +<% hi %> diff --git a/t/issues/gh-1046/config.yml b/t/issues/gh-1046/config.yml new file mode 100644 index 00000000..30b47a4d --- /dev/null +++ b/t/issues/gh-1046/config.yml @@ -0,0 +1 @@ +no_server_tokens: 1 diff --git a/t/issues/gh-1046/gh-1046.t b/t/issues/gh-1046/gh-1046.t new file mode 100644 index 00000000..b61ebf81 --- /dev/null +++ b/t/issues/gh-1046/gh-1046.t @@ -0,0 +1,23 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + ## no critic + package App; + use Dancer2; + get '/' => sub {1}; +} + +my $test = Plack::Test->create( App->to_app ); +my $res = $test->request( GET '/' ); + +is( + $res->headers->header('Server'), + undef, + 'Server header not available', +); + +done_testing; diff --git a/t/issues/gh-1070.t b/t/issues/gh-1070.t new file mode 100644 index 00000000..b8fa499a --- /dev/null +++ b/t/issues/gh-1070.t @@ -0,0 +1,22 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + set show_errors => 1; +} + +my $test = Plack::Test->create( App->to_app ); + +my $content = + $test->request( GET '/nonexistent_path<strong>crazy</strong>' )->content; + +like $content, qr{/nonexistent_path<strong>crazy</strong>}, + "Escaped message"; + +unlike $content, qr{/nonexistent_path<strong>crazy</strong>}, + "No unescaped message"; diff --git a/t/issues/gh-1098.t b/t/issues/gh-1098.t new file mode 100644 index 00000000..aed9eb75 --- /dev/null +++ b/t/issues/gh-1098.t @@ -0,0 +1,93 @@ +use Test::More tests => 3; +use Test::Fatal; + +use Dancer2::Core::Error; +use Dancer2::Core::Response; +use Dancer2::Serializer::JSON; +use HTTP::Headers; +use HTTP::Headers::Fast; +use JSON::MaybeXS; + +subtest 'Core::Error serializer isa tests' => sub { + plan tests => 5; + + is exception { Dancer2::Core::Error->new }, undef, "Error->new lived"; + + like exception { Dancer2::Core::Error->new(show_errors => []) }, + qr/Reference \Q[]\E did not pass type constraint "Bool"/i, + "Error->new(show_errors => []) died"; + + is exception { + Dancer2::Core::Error->new(serializer => undef) + }, + undef, + "Error->new(serializer => undef) lived"; + + is exception { + Dancer2::Core::Error->new(serializer => Dancer2::Serializer::JSON->new) + }, + undef, + "Error->new(serializer => Dancer2::Serializer::JSON->new) lived"; + + like exception { Dancer2::Core::Error->new(serializer => JSON->new) }, qr/ + ( + requires\sthat\sthe\sreference\sdoes\sDancer2::Core::Role::Serializer + | + did\snot\spass\stype\sconstraint + ) + /x, "Error->new(serializer => JSON->new) died"; +}; + +subtest 'Core::Response headers isa tests' => sub { + plan tests => 5; + + is exception { Dancer2::Core::Response->new }, + undef, "Response->new lived"; + + is exception { + Dancer2::Core::Response->new(headers => [Header => 'Content']) + }, + undef, + "Response->new( headers => [ Header => 'Content' ] ) lived"; + + is exception { + Dancer2::Core::Response->new(headers => HTTP::Headers->new) + }, + undef, + "Response->new( headers => HTTP::Headers->new ) lived"; + + is exception { + Dancer2::Core::Response->new(headers => HTTP::Headers::Fast->new) + }, + undef, + "Response->new( headers => HTTP::Headers::Fast->new ) lived"; + + like exception { + Dancer2::Core::Response->new(headers => JSON->new) + }, + qr/coercion.+failed.+not.+array/i, + "Response->new( headers => JSON->new ) died"; +}; + +subtest 'Core::Role::Logger log_level isa tests' => sub { + plan tests => 1 + 6 + 1; + + { + package TestLogger; + use Moo; + with 'Dancer2::Core::Role::Logger'; + sub log { } + } + + is exception { TestLogger->new }, undef, "Logger->new lived"; + + my @levels = qw/core debug info warn warning error/; + foreach my $level (@levels) { + is exception { TestLogger->new(log_level => $level) }, undef, + "Logger->new(log_level => $level) lives"; + } + + like exception { TestLogger->new(log_level => 'BadLevel') }, + qr/Value "BadLevel" did not pass type constraint "Enum/, + "Logger->new(log_level => 'BadLevel') died"; +}; diff --git a/t/issues/gh-1216/gh-1216.t b/t/issues/gh-1216/gh-1216.t new file mode 100644 index 00000000..0b6b04e3 --- /dev/null +++ b/t/issues/gh-1216/gh-1216.t @@ -0,0 +1,19 @@ +use strict; +use warnings; +use lib 't/issues/gh-1216/lib'; + +use Test::More 'tests' => 2; +use Test::Fatal qw<exception>; +use Module::Runtime qw<require_module>; + +my $app; +is( + exception { + require_module('App'); + $app = App->to_app; + }, + undef, + 'No exception when creating new app', +); + +isa_ok( $app, 'CODE' ); diff --git a/t/issues/gh-1216/lib/App.pm b/t/issues/gh-1216/lib/App.pm new file mode 100644 index 00000000..fbf2cc8d --- /dev/null +++ b/t/issues/gh-1216/lib/App.pm @@ -0,0 +1,4 @@ +package App; +use App::Extra; +use Dancer2; +1; diff --git a/t/issues/gh-1216/lib/App/Extra.pm b/t/issues/gh-1216/lib/App/Extra.pm new file mode 100644 index 00000000..3008b4d3 --- /dev/null +++ b/t/issues/gh-1216/lib/App/Extra.pm @@ -0,0 +1,7 @@ +package App::Extra; +use Dancer2 appname => 'App'; +use Dancer2::Plugin::Null; + +get '/' => sub {'OK'}; + +1; diff --git a/t/issues/gh-1216/lib/Dancer2/Plugin/Null.pm b/t/issues/gh-1216/lib/Dancer2/Plugin/Null.pm new file mode 100644 index 00000000..c6214054 --- /dev/null +++ b/t/issues/gh-1216/lib/Dancer2/Plugin/Null.pm @@ -0,0 +1,4 @@ +package Dancer2::Plugin::Null; +use Dancer2::Plugin; +register_plugin; +1; diff --git a/t/issues/gh-1226/gh-1226.t b/t/issues/gh-1226/gh-1226.t new file mode 100644 index 00000000..56f1ba2f --- /dev/null +++ b/t/issues/gh-1226/gh-1226.t @@ -0,0 +1,26 @@ +use strict; +use warnings; +use lib 't/issues/gh-1226/lib'; + +use Test::More 'tests' => 4 + 9; +use Test::Fatal qw<exception>; +use Plack::Test (); +use Module::Runtime qw<require_module>; +use HTTP::Request::Common qw<GET>; + +my $app; +is( + exception { + require_module('App'); + $app = App->to_app; + }, + undef, + 'No exception when creating new app', +); + +isa_ok( $app, 'CODE' ); + +my $test = Plack::Test->create($app); +my $response = $test->request( GET '/' ); +is( $response->code, 200, 'Correct response code' ); +is( $response->content, 'OK', 'Correct response content' ); diff --git a/t/issues/gh-1226/lib/App.pm b/t/issues/gh-1226/lib/App.pm new file mode 100644 index 00000000..a222078b --- /dev/null +++ b/t/issues/gh-1226/lib/App.pm @@ -0,0 +1,4 @@ +package App; +use Dancer2 appname => 'OtherApp'; +use App::Extra; +1; diff --git a/t/issues/gh-1226/lib/App/Extra.pm b/t/issues/gh-1226/lib/App/Extra.pm new file mode 100644 index 00000000..cdb99c16 --- /dev/null +++ b/t/issues/gh-1226/lib/App/Extra.pm @@ -0,0 +1,11 @@ +package App::Extra; +use Dancer2 'appname' => 'OtherApp'; +use Dancer2::Plugin::Test::AccessDSL; + +get '/' => sub { + status(500); + change_response_status(); + return 'OK'; +}; + +1; diff --git a/t/issues/gh-1226/lib/Dancer2/Plugin/Test/AccessDSL.pm b/t/issues/gh-1226/lib/Dancer2/Plugin/Test/AccessDSL.pm new file mode 100644 index 00000000..1acffac0 --- /dev/null +++ b/t/issues/gh-1226/lib/Dancer2/Plugin/Test/AccessDSL.pm @@ -0,0 +1,54 @@ +package Dancer2::Plugin::Test::AccessDSL; +use strict; +use warnings; +use Dancer2::Plugin; + +plugin_keywords('change_response_status'); + +sub change_response_status { + my $self = shift; + my $caller = caller(1); + ::is( $self->app->name, 'OtherApp', 'Appname is OtherApp' ); + ::is( $caller, 'App::Extra', 'The caller class is App::Extra' ); + + ::ok( + ::exception(sub{ $self->app->dsl }), + 'Cannot call DSL via app (bc appname is app)', + ); + + ::ok( + ::exception( sub { $self->app->name->dsl } ), + 'Cannot call DSL via appname (bc it is not the consumer class)', + ); + + ::ok( + ::exception( sub { OtherApp->status(400) } ), + 'Cannot call DSL via appname string (bc it is not the consumer class)', + ); + + ::is( + ::exception( sub { App::Extra::status(400) } ), + undef, + 'Was able to successfully call the DSL (via consumer class)', + ); + + ::is( + $self->app->response->status(), + 400, + 'Status was set correctly', + ); + + ::is( + ::exception( sub { $self->dsl->status(200) } ), + undef, + 'Was able to successfully call the DSL (via plugin->dsl)', + ); + + ::is( + $self->app->response->status(), + 200, + 'Status was set correctly', + ); +} + +1; diff --git a/t/issues/gh-1230/gh-1230.t b/t/issues/gh-1230/gh-1230.t new file mode 100644 index 00000000..a6cdef38 --- /dev/null +++ b/t/issues/gh-1230/gh-1230.t @@ -0,0 +1,26 @@ +use strict; +use warnings; +use lib 't/issues/gh-1230/lib'; + +use Test::More 'tests' => 4 + 5 + 9; +use Test::Fatal qw<exception>; +use Plack::Test (); +use Module::Runtime qw<require_module>; +use HTTP::Request::Common qw<GET>; + +my $app; +is( + exception { + require_module('App'); + $app = App->to_app; + }, + undef, + 'No exception when creating new app', +); + +isa_ok( $app, 'CODE' ); + +my $test = Plack::Test->create($app); +my $response = $test->request( GET '/' ); +is( $response->code, 200, 'Correct response code' ); +is( $response->content, 'OK', 'Correct response content' ); diff --git a/t/issues/gh-1230/lib/App.pm b/t/issues/gh-1230/lib/App.pm new file mode 100644 index 00000000..a222078b --- /dev/null +++ b/t/issues/gh-1230/lib/App.pm @@ -0,0 +1,4 @@ +package App; +use Dancer2 appname => 'OtherApp'; +use App::Extra; +1; diff --git a/t/issues/gh-1230/lib/App/Extra.pm b/t/issues/gh-1230/lib/App/Extra.pm new file mode 100644 index 00000000..f455232e --- /dev/null +++ b/t/issues/gh-1230/lib/App/Extra.pm @@ -0,0 +1,11 @@ +package App::Extra; +use Dancer2 'appname' => 'OtherApp'; +use Dancer2::Plugin::Test::AccessPluginDSL; + +get '/' => sub { + status(500); + test_change_response_status(); + return 'OK'; +}; + +1; diff --git a/t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessDSL.pm b/t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessDSL.pm new file mode 100644 index 00000000..0197c23d --- /dev/null +++ b/t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessDSL.pm @@ -0,0 +1,60 @@ +package Dancer2::Plugin::Test::AccessDSL; +use strict; +use warnings; +use Dancer2::Plugin; + +plugin_keywords('change_response_status'); + +sub change_response_status { + my $self = shift; + my $caller = caller(1); + + ::is( $self->app->name, 'OtherApp', 'Appname is OtherApp' ); + + ::is( + $caller, + 'Dancer2::Plugin::Test::AccessPluginDSL', + 'The caller class is the first plugin (AccessPluginDSL)', + ); + + ::ok( + ::exception(sub{ $self->app->dsl }), + 'Cannot call DSL via app (bc appname is app)', + ); + + ::ok( + ::exception( sub { $self->app->name->dsl } ), + 'Cannot call DSL via appname (bc it is not the consumer class)', + ); + + ::ok( + ::exception( sub { OtherApp->status(400) } ), + 'Cannot call DSL via appname string (bc it is not the consumer class)', + ); + + ::is( + ::exception( sub { App::Extra::status(400) } ), + undef, + 'Was able to successfully call the DSL (via consumer class)', + ); + + ::is( + $self->app->response->status(), + 400, + 'Status was set correctly', + ); + + ::is( + ::exception( sub { $self->dsl->status(200) } ), + undef, + 'Was able to successfully call the DSL (via plugin->dsl)', + ); + + ::is( + $self->app->response->status(), + 200, + 'Status was set correctly', + ); +} + +1; diff --git a/t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessPluginDSL.pm b/t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessPluginDSL.pm new file mode 100644 index 00000000..e962860f --- /dev/null +++ b/t/issues/gh-1230/lib/Dancer2/Plugin/Test/AccessPluginDSL.pm @@ -0,0 +1,33 @@ +package Dancer2::Plugin::Test::AccessPluginDSL; +use strict; +use warnings; +use Dancer2::Plugin; +use Dancer2::Plugin::Test::AccessDSL; + +plugin_keywords('test_change_response_status'); + +sub test_change_response_status { + my $self = shift; + my $caller = caller(1); + ::is( $self->app->name, 'OtherApp', 'Appname is OtherApp' ); + ::is( $caller, 'App::Extra', 'The caller class is App::Extra' ); + + ::ok( + ::exception( sub { App::Extra::change_response_status() } ), + 'App does not receive DSL from our inner Plugin', + ); + + ::is( + ::exception( sub { change_response_status() } ), + undef, + 'Successfully called the plugin DSL (via plugin->dsl)', + ); + + ::is( + $self->app->response->status(), + 200, + 'Status was set correctly', + ); +} + +1; diff --git a/t/issues/gh-1232.t b/t/issues/gh-1232.t new file mode 100644 index 00000000..05395711 --- /dev/null +++ b/t/issues/gh-1232.t @@ -0,0 +1,58 @@ +use strict; +use warnings; + +use Test::More tests => 1; +use Plack::Test; +use Plack::Builder; +use Plack::Request; +use HTTP::Request::Common; +use Encode qw(encode_utf8); + +{ + package App; + use Dancer2; + + # default, we're actually overriding this later + set serializer => 'JSON'; + + # for now + set logger => 'Capture'; + + post '/json' => sub { + my $p = body_parameters; + return [ map +( $_ => $p->get($_) ), sort $p->keys ]; + }; +} + +my $psgi = builder { + # inline middleware FTW! + # Create a Plack::Request object and parse body to tickle #1232 + enable sub { + my $app = shift; + sub { + my $req = Plack::Request->new($_[0])->body_parameters; + return $app->($_[0]); + } + }; + App->to_app; +}; + +my $test = Plack::Test->create( $psgi ); + +subtest 'POST request with parameters' => sub { + my $characters = encode_utf8("∑∏"); + + my $res = $test->request( + POST "/json", + 'Content-Type' => 'application/json', + 'Content' => qq!{ "foo": 1, "bar": 2, "baz": "$characters" }! + ); + + is( + $res->content, + qq!["bar",2,"baz","$characters","foo",1]!, + "Body parameters deserialized", + ); +}; + +done_testing();
\ No newline at end of file diff --git a/t/issues/gh-596.t b/t/issues/gh-596.t new file mode 100644 index 00000000..e19d3dd1 --- /dev/null +++ b/t/issues/gh-596.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; + +BEGIN { $ENV{'DANCER_NO_SERVER_TOKENS'} = 'foo' } + +{ + package App; + use Dancer2; + get '/' => sub { config->{'no_server_tokens'} }; +} + +my $test = Plack::Test->create( App->to_app ); +my $res = $test->request( GET '/' ); + +ok( $res->is_success, 'Successful' ); +is( $res->content, 'foo', 'Correct server tokens configuration' ); + diff --git a/t/issues/gh-634.t b/t/issues/gh-634.t new file mode 100644 index 00000000..01ce44ea --- /dev/null +++ b/t/issues/gh-634.t @@ -0,0 +1,119 @@ +use strict; +use warnings; +use Test::More tests=> 3; +use File::Temp qw/tempdir/; +use File::Spec; + +my $log_dir = tempdir( CLEANUP => 1 ); + +{ + package LogDirSpecified; + use Dancer2; + + set engines => { + logger => { + File => { + log_dir => $log_dir, + file_name => 'test_log.log', + } + } + }; + set logger => 'file'; +} + +{ + package NonExistLogDirSpecified; + use Dancer2; + + set engines => { + logger => { + File => { + log_dir => "$log_dir/notexist", + file_name => 'test_log.log', + } + } + }; + set logger => 'file'; +} + +{ + package LogDirNotSpecified; + use Dancer2; + + set logger => 'file'; +} + +my $check_cb = sub { + my ( $app, $dir, $file ) = @_; + my $logger = $app->logger_engine; + + isa_ok( $logger, 'Dancer2::Logger::File' ); + is( + $logger->environment, + $app->environment, + 'Logger got correct environment', + ); + + is( + $logger->location, + $app->config_location, + 'Logger got correct location', + ); + + is( + $logger->log_dir, + $dir, + 'Logger got correct log directory', + ); + + is( + $logger->file_name, + $file, + 'Logger got correct filename', + ); + + is( + $logger->log_file, + File::Spec->catfile( $dir, $file ), + 'Logger got correct log file', + ); +}; + +subtest 'test Logger::File with log_dir specified' => sub { + plan tests => 6; + my $app = [ + grep { $_->name eq 'LogDirSpecified' } @{ Dancer2->runner->apps } + ]->[0]; + + $check_cb->( $app, $log_dir, 'test_log.log' ); +}; + +subtest 'test Logger::File with log_dir NOT specified' => sub { + plan tests => 6; + my $app = [ + grep { $_->name eq 'LogDirNotSpecified' } @{ Dancer2->runner->apps } + ]->[0]; + + $check_cb->( + $app, + File::Spec->catdir( $app->config_location, 'logs' ), + $app->environment . '.log', + ); +}; + +subtest 'test Logger::File with non-existent log_dir specified' => sub { + plan tests => 6; + + my $app = [ + grep { $_->name eq 'NonExistLogDirSpecified'} @{ Dancer2->runner->apps } + ]->[0]; + + my $logger = $app->logger_engine; + + $check_cb->( + $app, + "$log_dir/notexist", + 'test_log.log', + ); +}; + diff --git a/t/issues/gh-639/fails/.dancer b/t/issues/gh-639/fails/.dancer new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/t/issues/gh-639/fails/.dancer diff --git a/t/issues/gh-639/fails/config.yml b/t/issues/gh-639/fails/config.yml new file mode 100644 index 00000000..09b135b9 --- /dev/null +++ b/t/issues/gh-639/fails/config.yml @@ -0,0 +1,3 @@ +engines: + foo: + bar: baz diff --git a/t/issues/gh-639/fails/issue.t b/t/issues/gh-639/fails/issue.t new file mode 100644 index 00000000..29fbff5a --- /dev/null +++ b/t/issues/gh-639/fails/issue.t @@ -0,0 +1,13 @@ +use strict; +use warnings; +use Test::More tests => 1; +use Test::Fatal; + +require Dancer2; + +like( + exception { Dancer2->import() }, + qr{Engine 'foo' is not supported}, + 'Correct compilation issue', +); + diff --git a/t/issues/gh-639/succeeds/.dancer b/t/issues/gh-639/succeeds/.dancer new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/t/issues/gh-639/succeeds/.dancer diff --git a/t/issues/gh-639/succeeds/config.yml b/t/issues/gh-639/succeeds/config.yml new file mode 100644 index 00000000..ea8ef7bf --- /dev/null +++ b/t/issues/gh-639/succeeds/config.yml @@ -0,0 +1,4 @@ +engines: + template: + foo: + bar: baz diff --git a/t/issues/gh-639/succeeds/issue.t b/t/issues/gh-639/succeeds/issue.t new file mode 100644 index 00000000..eef18710 --- /dev/null +++ b/t/issues/gh-639/succeeds/issue.t @@ -0,0 +1,13 @@ +use strict; +use warnings; +use Test::More tests => 1; +use Test::Fatal; + +require Dancer2; + +is( + exception { Dancer2->import() }, + undef, + 'No compilation issue', +); + diff --git a/t/issues/gh-650/gh-650.t b/t/issues/gh-650/gh-650.t new file mode 100644 index 00000000..9f5b844d --- /dev/null +++ b/t/issues/gh-650/gh-650.t @@ -0,0 +1,49 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +BEGIN{ + # undefine ENV vars used as defaults for app environment in these tests + delete $ENV{DANCER_ENVIRONMENT}; + delete $ENV{PLACK_ENV}; +} + +{ + package MyApp; + + use Dancer2; + + set template => 'template_toolkit'; + + get '/foo' => sub { + template 'environment_setting' + }; + get '/bar' => sub { + set environment => 'development'; + template 'environment_setting' + }; +} + +my $app = Dancer2->psgi_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + my $res; + + $res = $cb->(GET '/foo'); + is $res->code, 200, 'Successful request'; + like $res->content, qr/development/, 'Correct content'; + + $res = $cb->(GET '/bar'); + is $res->code, 200, 'Successful request'; + like $res->content, qr/development/, 'Correct content'; +}; + +done_testing(); diff --git a/t/issues/gh-650/views/environment_setting.tt b/t/issues/gh-650/views/environment_setting.tt new file mode 100644 index 00000000..77fd25a2 --- /dev/null +++ b/t/issues/gh-650/views/environment_setting.tt @@ -0,0 +1 @@ +[% settings.environment %] diff --git a/t/issues/gh-723.t b/t/issues/gh-723.t new file mode 100644 index 00000000..7f3d78aa --- /dev/null +++ b/t/issues/gh-723.t @@ -0,0 +1,55 @@ +use strict; +use warnings; +use Test::More tests => 4; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + get '/' => sub {'OK'}; +} + +{ + package App::Extended; + use Dancer2; + prefix '/test'; + get '/' => sub {'Also OK'}; + post '/' => sub { + my $params = params; + ::isa_ok( $params, 'HASH' ); + ::is( $params->{'foo'}, 'bar', 'Got params' ); + return $params->{'foo'}; + }; +} + +my $app = Dancer2->psgi_app; +isa_ok( $app, 'CODE' ); + +my $test = Plack::Test->create($app); + +subtest 'GET /' => sub { + plan tests => 2; + my $res = $test->request( GET '/' ); + is( $res->code, 200, 'Correct code' ); + is( $res->content, 'OK', 'Correct content' ); +}; + +subtest 'GET /test/' => sub { + plan tests => 2; + my $res = $test->request( GET '/test/' ); + is( $res->code, 200, 'Correct code' ); + is( $res->content, 'Also OK', 'Correct content' ); +}; + +subtest 'Missing POST params' => sub { + plan tests => 4; + my $res = $test->request( + POST '/test/', + { foo => 'bar' }, + ); + + is( $res->code, 200, 'Correct code' ); + is( $res->content, 'bar', 'Correct content' ); +}; + diff --git a/t/issues/gh-730.t b/t/issues/gh-730.t new file mode 100644 index 00000000..adc519cf --- /dev/null +++ b/t/issues/gh-730.t @@ -0,0 +1,69 @@ +use strict; +use warnings; +use Test::More tests => 3; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + + get '/' => sub { request->is_behind_proxy }; +} + +my $app = App->to_app; +isa_ok( $app, 'CODE' ); + +my $test = Plack::Test->create($app); + +subtest 'Runner config' => sub { + plan tests => 5; + + is( + Dancer2->runner->config->{'behind_proxy'}, + 0, + 'No default behind_proxy', + ); + + is( + scalar @{ Dancer2->runner->apps }, + 1, + 'Single app registered', + ); + + isa_ok( + Dancer2->runner->apps->[0], + 'Dancer2::Core::App', + 'Correct app registered', + ); + + is( + Dancer2->runner->apps->[0]->setting('behind_proxy'), + 0, + 'behind_proxy not defined by default in an app', + ); + + Dancer2->runner->apps->[0]->config->{'behind_proxy'} = 1; + + is( + Dancer2->runner->apps->[0]->setting('behind_proxy'), + 1, + 'Set behind_proxy locally in the app to one', + ); + +}; + +subtest 'Using App-level settings' => sub { + plan tests => 3; + + is( + Dancer2->runner->config->{'behind_proxy'}, + 0, + 'Runner\'s behind_proxy is still the default', + ); + + my $res = $test->request( GET '/' ); + is( $res->code, 200, '[GET /] Correct code' ); + is( $res->content, '1', '[GET /] Local value achieved' ); +}; + diff --git a/t/issues/gh-762.t b/t/issues/gh-762.t new file mode 100644 index 00000000..a3a4f3cc --- /dev/null +++ b/t/issues/gh-762.t @@ -0,0 +1,41 @@ +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package FourOhFour; + + use Dancer2; + + set views => 't/issues/gh-762/views'; + + get '/error' => sub { + send_error "oh my", 404; + }; + +} + +my $fourohfour_app = FourOhFour->to_app; +my $fourohfour_test = Plack::Test->create($fourohfour_app); + +subtest "/error" => sub { + my $res = $fourohfour_test->request( GET '/error' ); + + is $res->code, 404, 'send_error sets the status to 404'; + like $res->content, qr{Template selected}, 'Error message looks good'; + like $res->content, qr{message: oh my}; + like $res->content, qr{status: 404}; +}; + +subtest 'FourOhFour with views template' => sub { + my $path = "/middle/of/nowhere"; + my $res = $fourohfour_test->request( GET $path ); + + is $res->code, 404, 'unknown route => 404'; + like $res->content, qr{Template selected}, 'Error message looks good'; + like $res->content, qr{message: $path}; + like $res->content, qr{status: 404}; +}; + +done_testing(); + diff --git a/t/issues/gh-762/views/404.tt b/t/issues/gh-762/views/404.tt new file mode 100644 index 00000000..25c53d71 --- /dev/null +++ b/t/issues/gh-762/views/404.tt @@ -0,0 +1,4 @@ +Template selected. + +message: [% content %] +status: [% status %] diff --git a/t/issues/gh-794.t b/t/issues/gh-794.t new file mode 100644 index 00000000..3200b5ff --- /dev/null +++ b/t/issues/gh-794.t @@ -0,0 +1,27 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + set serializer => 'JSON'; + + post '/' => sub { request->data }; +} + +my $test = Plack::Test->create( App->to_app ); + +is( + $test->request( POST '/', Content => '{"foo":42}' )->content, + '{"foo":42}', + 'Correct JSON content in POST', +); + +is( + $test->request( POST '/', Content => 'invalid' )->code, + 500, + 'Failed to decode invalid content', +); diff --git a/t/issues/gh-797.t b/t/issues/gh-797.t new file mode 100644 index 00000000..14a74bb0 --- /dev/null +++ b/t/issues/gh-797.t @@ -0,0 +1,56 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use JSON::MaybeXS; + +{ + package App; + use Dancer2; + set serializer => 'JSON'; + + post '/' => sub { + my $post_params = params('body'); + + # should work even with empty post body + my $foo = $post_params->{'foo'}; + return { foo => $foo }; + }; +} + +my $test = Plack::Test->create( App->to_app ); +my %headers; + +subtest 'Basic response failing' => sub { + TODO: { + local $TODO = '500 when deserializing bad input'; + my $res = $test->request( POST '/', { foo => 'bar' }, %headers ); + is( $res->code, 500, '[POST /] Failed when sending regular params' ); + } +}; + +subtest 'Basic response' => sub { + my $res = $test->request( + POST '/', + %headers, + Content => encode_json { foo => 'bar' } + ); + + is( $res->code, 200, '[POST /] Correct response code' ); + + my $response_data = decode_json( $res->decoded_content ); + is($response_data->{foo}, 'bar', "[POST /] Correct response data"); +}; + +subtest 'Empty POST' => sub { + my $res = $test->request( POST '/', {}, %headers ); + is( + $res->code, + 200, + '[POST /] Correct response code with empty post body', + ); +}; + +done_testing(); + diff --git a/t/issues/gh-799.t b/t/issues/gh-799.t new file mode 100644 index 00000000..fc186c48 --- /dev/null +++ b/t/issues/gh-799.t @@ -0,0 +1,64 @@ +use strict; +use warnings; +use Test::More tests => 1; +use Test::Fatal; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + + set log => 'core'; + set engines => { + logger => { Capture => { log_format => '%{x-test}h %i' } }, + }; + + set logger => 'Capture'; + + get '/' => sub { + my $req = app->request; + ::isa_ok( $req, 'Dancer2::Core::Request' ); + + my $logger = app->engine('logger'); + ::isa_ok( $logger, 'Dancer2::Logger::Capture' ); + ::can_ok( $logger, 'format_message' ); + + my $trap = $logger->trapper; + ::isa_ok( $trap, 'Dancer2::Logger::Capture::Trap' ); + my $msg = $trap->read; + ::is_deeply( + $msg, + [ + { + level => 'core', + message => 'looking for get /', + formatted => "- 1\n", + }, + + { + level => 'core', + message => 'Entering hook core.app.before_request', + formatted => "- 1\n", + }, + ], + 'Messages logged successfully', + ); + + ::can_ok( $logger, 'format_message' ); + my $fmt_str = $logger->format_message( + $msg->[0]{'debug'}, $msg->[0]{'message'} + ); + + ::is( $fmt_str, "- 1\n", 'Correct formatted message created' ); + + return; + }; +} + +my $test = Plack::Test->create( App->to_app ); + +subtest 'Logger can access request' => sub { + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); +}; diff --git a/t/issues/gh-811.t b/t/issues/gh-811.t new file mode 100644 index 00000000..46bc3144 --- /dev/null +++ b/t/issues/gh-811.t @@ -0,0 +1,56 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Cookies; +use HTTP::Request::Common; + +eval { require Dancer2::Session::Cookie; 1 } + or plan skip_all => 'Dancer2::Session::Cookie probably missing.'; + +{ + package App; + use Dancer2; + + set engines => { + session => { + Cookie => { secret_key => 'you cannot buy happiness' } + } + }; + + set session => 'Cookie'; + + get '/set' => sub { + session foo => 'bar'; + redirect '/get'; + }; + + get '/get' => sub { + my $data = session->data; + return to_json $data; + }; +} + +my $test = Plack::Test->create( App->to_app ); +my $jar = HTTP::Cookies->new; +my $url = 'http://localhost'; +my $redir; + +subtest 'Creating a session' => sub { + my $res = $test->request( GET "$url/set" ); + ok( $res->is_redirect, 'Request causes redirect' ); + ($redir) = $res->header('Location'); + is( $redir, "$url/get", 'Redirects to correct url' ); + $jar->extract_cookies($res); + ok( $jar->as_string, 'Received a session cookie' ); +}; + +subtest 'Retrieving a session' => sub { + my $req = GET $redir; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok( $res->is_success, 'Successful request' ); + is( $res->content, '{"foo":"bar"}', 'Correct response' ); +}; + +done_testing; diff --git a/t/issues/gh-931.t b/t/issues/gh-931.t new file mode 100644 index 00000000..efc85343 --- /dev/null +++ b/t/issues/gh-931.t @@ -0,0 +1,75 @@ +# this test checks the order of parameters precedence +# we run a few request to a route +# first we check that the route parameters have precedence +# then we check that the body parameters have the next +# and finally, when others aren't available, query parameters +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; ## no critic + use Dancer2; + + sub query_ok { + ::is( + params('query')->{'var'}, + 'QueryVar', + 'Query variable exists', + ); + } + + sub body_ok { + ::is( + params('body')->{'var'}, + 'BodyVar', + 'Body variable exists', + ); + } + + sub route_ok { + ::is( + params('route')->{'var'}, + 'RouteVar', + 'Route variable exists', + ); + } + + post '/:var' => sub { + query_ok(); + body_ok(); + route_ok(); + + ::is( + params->{'var'}, + 'RouteVar', + 'Route variable wins', + ); + + }; + + post '/' => sub { + query_ok(); + body_ok(); + + ::is( + params->{'var'}, + 'BodyVar', + 'Body variable wins', + ); + }; +} + +my $test = Plack::Test->create( App->to_app ); + +subtest 'Route takes precedence over all other parameters' => sub { + $test->request( POST '/RouteVar?var=QueryVar', [ var => 'BodyVar' ] ); +}; + +subtest 'When route parameters not available, POST takes precedence' => sub { + $test->request( POST '/?var=QueryVar', [ var => 'BodyVar' ] ); +}; + +done_testing(); diff --git a/t/issues/gh-936.t b/t/issues/gh-936.t new file mode 100644 index 00000000..9b2650cf --- /dev/null +++ b/t/issues/gh-936.t @@ -0,0 +1,33 @@ +use warnings; +use strict; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package TestApp; + use Dancer2; + + set views => 't/issues/gh-936/views'; + set error_template => 'error'; + + get '/does-not-exist' => sub { + send_error "not found", 404; + }; +} + +my $test = Plack::Test->create( Dancer2->psgi_app ); + +for my $path ( qw{does-not-exist anywhere} ) { + subtest "$path" => sub { + my $res = $test->request( GET "/$path" ); + + is $res->code, 404, 'status is 404'; + like $res->content, qr{CUSTOM ERROR TEMPLATE GOES HERE}, + 'Error message looks good'; + }; +} + +done_testing(); + diff --git a/t/issues/gh-936/views/error.tt b/t/issues/gh-936/views/error.tt new file mode 100644 index 00000000..ff9aa7fb --- /dev/null +++ b/t/issues/gh-936/views/error.tt @@ -0,0 +1 @@ +*CUSTOM ERROR TEMPLATE GOES HERE* diff --git a/t/issues/gh-944.t b/t/issues/gh-944.t new file mode 100644 index 00000000..b53470a4 --- /dev/null +++ b/t/issues/gh-944.t @@ -0,0 +1,43 @@ +use strict; +use warnings; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package RouteContentTest; ## no critic + use Dancer2; + set serializer => 'JSON'; + + hook before => sub { + return if request->path eq '/content'; + response->content({ foo => 'bar' }); + response->halt; + }; + + get '/' => sub {1}; + + get '/content' => sub { + response->content({ foo => 'bar' }); + return 'this is ignored'; + }; +} + +my $test = Plack::Test->create( RouteContentTest->to_app ); + +subtest "response set in before hook" => sub { + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful request' ); + is( $res->content, '{"foo":"bar"}', 'Correct content' ); +}; + +subtest "response content set in route" => sub { + my $res = $test->request( GET '/content' ); + ok( $res->is_success, 'Successful request' ); + isnt( $res->content, 'this is ignored', 'route return value ignored' ); + is( $res->content, '{"foo":"bar"}', 'Correct content' ); +}; + +done_testing(); + diff --git a/t/issues/gh-975/config.yml b/t/issues/gh-975/config.yml new file mode 100644 index 00000000..727e3358 --- /dev/null +++ b/t/issues/gh-975/config.yml @@ -0,0 +1 @@ +public_dir: "t/issues/gh-975/test_public_dir" diff --git a/t/issues/gh-975/gh-975.t b/t/issues/gh-975/gh-975.t new file mode 100644 index 00000000..af0e452d --- /dev/null +++ b/t/issues/gh-975/gh-975.t @@ -0,0 +1,15 @@ +use strict; +use warnings; +use Test::More 'tests' => 2; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; +} + +my $test = Plack::Test->create( App->to_app ); +my $res = $test->request( GET '/test.txt' ); +ok( $res->is_success, 'Succeeded retrieving file' ); +like( $res->content, qr{^this is test\.txt}, 'Correct file content' ); diff --git a/t/issues/gh-975/test_public_dir/test.txt b/t/issues/gh-975/test_public_dir/test.txt new file mode 100644 index 00000000..66e61107 --- /dev/null +++ b/t/issues/gh-975/test_public_dir/test.txt @@ -0,0 +1 @@ +this is test.txt diff --git a/t/issues/memleak/die_in_hooks.t b/t/issues/memleak/die_in_hooks.t new file mode 100644 index 00000000..0648c831 --- /dev/null +++ b/t/issues/memleak/die_in_hooks.t @@ -0,0 +1,55 @@ +# reported memory leak without GH issue or RT ticket +use strict; +use warnings; +use Test::More tests => 6; +use Plack::Test; +use Capture::Tiny 'capture_stderr'; +use HTTP::Request::Common; + +my $called; +{ package Foo::Destroy; sub DESTROY { $called++ } } ## no critic + +{ + package App; ## no critic + use Dancer2; + my $env_key = 'psgix.ignoreme.refleak'; + + hook before => sub { + request->env->{$env_key} = bless {}, 'Foo::Destroy'; + }; + + hook before => sub { + ::ok( request->env->{$env_key}, 'Object exists' ); + ::isa_ok( request->env->{$env_key}, 'Foo::Destroy', 'It is an object' ); + + die "whoops"; + }; + + get '/' => sub {'OK'}; +} + +my $test = Plack::Test->create( App->to_app ); +my $res; +my $stderr = capture_stderr { $res = $test->request( GET '/' ) }; + +ok( ! $res->is_success, 'Request failed' ); +is( $res->code, 500, 'Failure status' ); +is( $called, 1, 'Memory cleaned' ); + +# double check stderr +# '[App:21992] error @2015-03-03 16:39:07> Exception caught in 'core.app.before_request' filter: Hook error: whoops at t/issues/memleak/die_in_hooks.t line 25. +# at lib/Dancer2/Core/App.pm line 848. in (eval 117) l. 1 +# at ... +# ' +like( + $stderr, + qr{ + ^ + \[App:\d+\] \s error \s [\@\-\d\s:]+> \s + \QException caught in 'core.app.before_request' filter:\E \s + \QHook error: whoops\E \s + [^\n]+ \n \s* # everything until newline + newline + at [^\n]+ \n # another such line (there could be more) + }x, + 'Correct error', +); diff --git a/t/issues/vars-in-forward.t b/t/issues/vars-in-forward.t new file mode 100644 index 00000000..927a78f0 --- /dev/null +++ b/t/issues/vars-in-forward.t @@ -0,0 +1,24 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + get '/' => sub { + var foo => 'bar'; + forward '/next'; + }; + + get '/next' => sub { + vars->{'foo'}; + }; +} + +my $test = Plack::Test->create( App->to_app ); +my $res = $test->request( GET '/' ); + +ok( $res->is_success, 'Successful response' ); +is( $res->content, 'bar', 'Correct response' ); diff --git a/t/lib/App1.pm b/t/lib/App1.pm new file mode 100644 index 00000000..f830e291 --- /dev/null +++ b/t/lib/App1.pm @@ -0,0 +1,15 @@ +package t::lib::App1; +use strict; +use warnings; + +use Dancer2; +use lib '.'; +use t::lib::DancerPlugin; + +install_hooks; + +get '/app1' => sub { + session 'before_plugin'; +}; + +1; diff --git a/t/lib/App2.pm b/t/lib/App2.pm new file mode 100644 index 00000000..31b32796 --- /dev/null +++ b/t/lib/App2.pm @@ -0,0 +1,15 @@ +package t::lib::App2; +use strict; +use warnings; + +use Dancer2; +use lib '.'; +use t::lib::DancerPlugin; + +install_hooks; + +get '/app2' => sub { + session 'before_plugin'; +}; + +1; diff --git a/t/lib/Dancer2/Plugin/Bar.pm b/t/lib/Dancer2/Plugin/Bar.pm new file mode 100644 index 00000000..57dc475a --- /dev/null +++ b/t/lib/Dancer2/Plugin/Bar.pm @@ -0,0 +1,23 @@ +package Dancer2::Plugin::Bar; + +use strict; +use warnings; + +use Dancer2::Plugin; + +sub baz { 'bazbazbaz' } + +sub BUILD { + my $plugin = shift; + + $plugin->app->add_hook( Dancer2::Core::Hook->new( + name => 'after', + code => sub { my $resp = shift; $resp->content( $resp->content + . 'plugin Bar loaded' + ) } + )); +} + +1; + + diff --git a/t/lib/Dancer2/Plugin/DancerPlugin.pm b/t/lib/Dancer2/Plugin/DancerPlugin.pm new file mode 100644 index 00000000..e4df3b81 --- /dev/null +++ b/t/lib/Dancer2/Plugin/DancerPlugin.pm @@ -0,0 +1,28 @@ +package Dancer2::Plugin::DancerPlugin; +use strict; +use warnings; + +use Dancer2::Plugin; +my $counter = 0; + +register around_get => sub { + my $dsl = shift; + $dsl->get( + '/foo/plugin' => sub { + 'foo plugin'; + } + ); +}; + +register install_hooks => sub { + my $dsl = shift; + $dsl->app->add_hook( Dancer2::Core::Hook->new( + name => 'before', + code => sub { + $dsl->session( before_plugin => ++$counter ); + } + )); +}; + +register_plugin; +1; diff --git a/t/lib/Dancer2/Plugin/DefineKeywords.pm b/t/lib/Dancer2/Plugin/DefineKeywords.pm new file mode 100644 index 00000000..681d3667 --- /dev/null +++ b/t/lib/Dancer2/Plugin/DefineKeywords.pm @@ -0,0 +1,32 @@ +package Dancer2::Plugin::DefineKeywords; + +use Dancer2::Plugin; + +push @::expected_keywords, 'foo'; +plugin_keywords foo => sub { 'foo' }; + +push @::expected_keywords, 'bar'; +has bar => ( + is => 'ro', + plugin_keyword => 1, + default => sub { 'bar' }, +); + +push @::expected_keywords, 'baz', 'bazz'; +has baz => ( + is => 'ro', + plugin_keyword => [ qw/ baz bazz / ], +); + +push @::expected_keywords, 'biz'; +has boz => ( + is => 'ro', + plugin_keyword => 'biz', +); + +push @::expected_keywords, 'quux', 'qiix', 'qox', 'qooox'; +sub quux :PluginKeyword { 'quux' }; +sub qaax :PluginKeyword(qiix) { die "unimplemented" }; +sub qoox :PluginKeyword(qox qooox) { die "unimplemented" }; + +1; diff --git a/t/lib/Dancer2/Plugin/EmptyPlugin.pm b/t/lib/Dancer2/Plugin/EmptyPlugin.pm new file mode 100644 index 00000000..d47f09ba --- /dev/null +++ b/t/lib/Dancer2/Plugin/EmptyPlugin.pm @@ -0,0 +1,10 @@ +package Dancer2::Plugin::EmptyPlugin; +use Dancer2::Plugin; + +# This plugin does nothing. +# Based on test from @e11it in #510 + +register_plugin; + +1; + diff --git a/t/lib/Dancer2/Plugin/Foo.pm b/t/lib/Dancer2/Plugin/Foo.pm new file mode 100644 index 00000000..b4cadd82 --- /dev/null +++ b/t/lib/Dancer2/Plugin/Foo.pm @@ -0,0 +1,52 @@ +package Dancer2::Plugin::Foo; + +use strict; +use warnings; + +use Dancer2::Plugin; + +plugin_keywords 'truncate_txt'; + +has something => ( + is => 'ro', + lazy => 1, + default => sub { + $_[0]->config->{one}; + }, +); + +has size => ( + is => 'ro', + lazy => 1, + default => sub { + $_[0]->config->{size} || 99; + }, +); + +has bar => ( + is => 'ro', + lazy => 1, + default => sub { + scalar $_[0]->app->with_plugin( 'Bar' ) + }, + handles => { 'bar_baz' => 'baz' }, +); + +sub BUILD { + my $plugin = shift; + + $plugin->app->add_hook( Dancer2::Core::Hook->new( + name => 'after', + code => sub { my $resp = shift; $resp->content( $resp->content + . 'added by plugin with something:' . $plugin->something + . $plugin->bar_baz + ) } + )); +} + +sub truncate_txt { + my( $plugin, $text ) = @_; + return substr $text, 0, $plugin->size; +} + +1; diff --git a/t/lib/Dancer2/Plugin/FooPlugin.pm b/t/lib/Dancer2/Plugin/FooPlugin.pm new file mode 100644 index 00000000..7f18cd7b --- /dev/null +++ b/t/lib/Dancer2/Plugin/FooPlugin.pm @@ -0,0 +1,62 @@ +package Dancer2::Plugin::FooPlugin; +use Dancer2::Plugin; + +on_plugin_import { + my $dsl = shift; + $dsl->get( '/sitemap' => sub { _html_sitemap($dsl) } ); +}; + +sub _html_sitemap { + join( ', ', _retrieve_get_urls(@_) ); +} + +register foo_wrap_request => sub { + my ($self) = @_; + return $self->app->request; +}, { is_global => 0 }; + +register foo_route => sub { + my ($self) = @_; + $self->get( '/foo', sub {'foo'} ); +} => { is_global => 1, prototype => '$@' }; + +register p_config => sub { + my $dsl = shift; + my $config = plugin_setting; + return $config; +}; + +# taken from SiteMap +sub _retrieve_get_urls { + my $dsl = shift; + my ( $route, @urls ); + + for my $app ( @{ $dsl->runner->apps } ) { + my $routes = $app->routes; + + # push the static get routes into an array. + get_route: + for my $get_route ( @{ $routes->{get} } ) { + my $regexp = $get_route->regexp; + + # If the pattern is a true comprehensive regexp or the route + # has a :variable element to it, then omit it. + next get_route if ( $regexp =~ m/[()[\]|]|:\w/ ); + + # If there is a wildcard modifier, then drop it and have the + # full route. + $regexp =~ s/\?//g; + + # Other than that, its cool to be added. + push( @urls, $regexp ) + if !grep { $regexp =~ m/$_/i } + @$Dancer2::Plugin::SiteMap::OMIT_ROUTES; + } + } + + return sort(@urls); +} + + +register_plugin; +1; diff --git a/t/lib/Dancer2/Plugin/Hookee.pm b/t/lib/Dancer2/Plugin/Hookee.pm new file mode 100644 index 00000000..d18a4d08 --- /dev/null +++ b/t/lib/Dancer2/Plugin/Hookee.pm @@ -0,0 +1,18 @@ +package Dancer2::Plugin::Hookee; + +use Dancer2::Plugin; + +register_hook 'start_hookee', 'stop_hookee'; +register_hook 'third_hook'; + +register some_keyword => sub { + execute_hook('start_hookee'); +}; + +register some_other => sub { + execute_hook('third_hook'); +}; + +register_plugin; + +1; diff --git a/t/lib/Dancer2/Plugin/OnPluginImport.pm b/t/lib/Dancer2/Plugin/OnPluginImport.pm new file mode 100644 index 00000000..120a2538 --- /dev/null +++ b/t/lib/Dancer2/Plugin/OnPluginImport.pm @@ -0,0 +1,26 @@ +package Dancer2::Plugin::OnPluginImport; +use Dancer2::Plugin; + +# register keyword +register some_import => sub { shift->dancer_version }; + +# register hook +register_hook qw(imported_plugin); + +# add hook. This triggers the $dsl->hooks attribute +# to be built plugins added after this should still +# be able to register and add hooks. See #889. +on_plugin_import { + my $dsl = shift; + + $dsl->app->add_hook( + Dancer2::Core::Hook->new( + name => 'imported_plugin', + code => sub { $dsl->dancer_version } + ) + ); +}; + +register_plugin; + +1; diff --git a/t/lib/Dancer2/Plugin/PluginWithImport.pm b/t/lib/Dancer2/Plugin/PluginWithImport.pm new file mode 100644 index 00000000..9c2ec627 --- /dev/null +++ b/t/lib/Dancer2/Plugin/PluginWithImport.pm @@ -0,0 +1,27 @@ +package Dancer2::Plugin::PluginWithImport; +# ABSTRACT: a plugin that implement its own import method + +=head1 DESCRIPTION + +In order to demonstrate that Dancer2::Plugin won't loose the original +import method of the plugin. + +=cut + +use strict; +use warnings; + +use Dancer2::Plugin; + +my $_stuff = {}; +sub stuff {$_stuff} + +$_stuff->{ __PACKAGE__, } = 'imported'; + +register dancer_plugin_with_import_keyword => sub { + 'dancer_plugin_with_import_keyword'; +}; + +register_plugin; + +1; diff --git a/t/lib/Dancer2/Plugin/Polite.pm b/t/lib/Dancer2/Plugin/Polite.pm new file mode 100644 index 00000000..fd9f1869 --- /dev/null +++ b/t/lib/Dancer2/Plugin/Polite.pm @@ -0,0 +1,44 @@ +package Dancer2::Plugin::Polite; + +use strict; +use warnings; + +use Dancer2::Plugin; + +has smiley => ( + is => 'ro', + default => sub { + $_[0]->config->{smiley} || ':-)' + } +); + +plugin_keywords 'add_smileys'; + +sub BUILD { + my $plugin = shift; + + $plugin->app->add_hook( Dancer2::Core::Hook->new( + name => 'after', + code => sub { $_[0]->content( $_[0]->content . " ... please?" ) } + )); + + $plugin->app->add_route( + method => 'get', + regexp => '/goodbye', + code => sub { 'farewell!' }, + ); + +} + +sub add_smileys { + my( $plugin, $text ) = @_; + + $text =~ s/ (?<= \. ) / $plugin->smiley /xeg; + + return $text; +} + +1; + + + diff --git a/t/lib/Dancer2/Session/SimpleNoChangeId.pm b/t/lib/Dancer2/Session/SimpleNoChangeId.pm new file mode 100644 index 00000000..f3eafa59 --- /dev/null +++ b/t/lib/Dancer2/Session/SimpleNoChangeId.pm @@ -0,0 +1,41 @@ +package Dancer2::Session::SimpleNoChangeId; +# ABSTRACT: in-memory session backend for Dancer2 +# +# This is a version of Dancer2::Session::Simple that does not support +# _change_id thus using stash data/destroy/reload session + +use Moo; +use Dancer2::Core::Types; +use Carp; + +with 'Dancer2::Core::Role::SessionFactory'; + +# The singleton that contains all the session objects created +my $SESSIONS = {}; + +sub _sessions { + my ($self) = @_; + return [ keys %{$SESSIONS} ]; +} + +sub _retrieve { + my ( $class, $id ) = @_; + my $s = $SESSIONS->{$id}; + + croak "Invalid session ID: $id" + if !defined $s; + + return $s; +} + +sub _destroy { + my ( $class, $id ) = @_; + delete $SESSIONS->{$id}; +} + +sub _flush { + my ( $class, $id, $data ) = @_; + $SESSIONS->{$id} = $data; +} + +1; diff --git a/t/lib/Foo.pm b/t/lib/Foo.pm new file mode 100644 index 00000000..7fab1134 --- /dev/null +++ b/t/lib/Foo.pm @@ -0,0 +1,8 @@ +package t::lib::Foo; +use Dancer2; + +get '/in_foo' => sub { + session('test'); +}; + +1; diff --git a/t/lib/MyDancerDSL.pm b/t/lib/MyDancerDSL.pm new file mode 100644 index 00000000..72eae707 --- /dev/null +++ b/t/lib/MyDancerDSL.pm @@ -0,0 +1,36 @@ +package MyDancerDSL; + +use Moo; +use Dancer2::Core::Hook; +use Dancer2::Core::Error; +use Dancer2::FileUtils; +use Carp; + +extends 'Dancer2::Core::DSL'; + +around dsl_keywords => sub { + my $orig = shift; + my $keywords = $orig->(@_); + + $keywords->{gateau} = { is_global => 0 }; # cookie + $keywords->{moteur} = { is_global => 1 }; # engine + $keywords->{stop} = { is_global => 0 }; # halt + $keywords->{prend} = { is_global => 1, prototype => '@' }; # get + $keywords->{envoie} = { is_global => 1, prototype => '$&' }; # post + $keywords->{entete} = { is_global => 0 }; #header + + $keywords->{proto} = { is_global => 1, prototype => '&' }; # prototype + + return $keywords; +}; + +sub gateau { goto &Dancer2::Core::DSL::cookie } +sub moteur { goto &Dancer2::Core::DSL::engine } +sub stop { goto &Dancer2::Core::DSL::halt } +sub prend { goto &Dancer2::Core::DSL::get } +sub envoie { goto &Dancer2::Core::DSL::post } +sub entete { goto &Dancer2::Core::DSL::header } + +sub proto { $_[1]->() } + +1; diff --git a/t/lib/PoC/Plugin/Polite.pm b/t/lib/PoC/Plugin/Polite.pm new file mode 100644 index 00000000..4785f27d --- /dev/null +++ b/t/lib/PoC/Plugin/Polite.pm @@ -0,0 +1,27 @@ +package PoC::Plugin::Polite; +# ABSTRACT - register Dancer2::Plugin::Polite under a diferent namespace + +use Dancer2::Plugin; + +has polite => ( + is => 'ro', + lazy => 1, + default => sub { + $_[0]->app->with_plugin( 'Polite' ); + }, + handles => [ qw( smiley add_smileys ) ], +); + +register_hook 'smileys'; + +plugin_keywords qw(add_smileys hooked_smileys); + +sub hooked_smileys { + my ($self, @args) = @_; + $self->execute_plugin_hook('smileys'); + $self->add_smileys(@args); +}; + +register_plugin; +1; + diff --git a/t/lib/SubApp1.pm b/t/lib/SubApp1.pm new file mode 100644 index 00000000..6337a738 --- /dev/null +++ b/t/lib/SubApp1.pm @@ -0,0 +1,14 @@ +package t::lib::SubApp1; +use strict; +use warnings; + +use Dancer2; +use lib 't/lib'; +use Dancer2::Plugin::DancerPlugin; +install_hooks; + +get '/subapp1' => sub { + 1; +}; + +1; diff --git a/t/lib/SubApp2.pm b/t/lib/SubApp2.pm new file mode 100644 index 00000000..16c60a75 --- /dev/null +++ b/t/lib/SubApp2.pm @@ -0,0 +1,14 @@ +package t::lib::SubApp2; +use strict; +use warnings; + +use Dancer2; +use lib 't/lib'; +use Dancer2::Plugin::DancerPlugin; +install_hooks; + +get '/subapp2' => sub { + 2; +}; + +1; diff --git a/t/lib/TestApp.pm b/t/lib/TestApp.pm new file mode 100644 index 00000000..a60290d2 --- /dev/null +++ b/t/lib/TestApp.pm @@ -0,0 +1,125 @@ +package t::lib::TestApp; +use Dancer2; + +# this app is intended to cover 100% of the DSL! + +# set some MIME aliases... +mime->add_type( foo => 'text/foo' ); +mime->add_alias( f => 'foo' ); + +set 'default_mime_type' => 'text/bar'; + +# hello route +get '/' => sub { app->name }; + +# /haltme should bounce to / +hook 'before' => sub { + if ( request->path_info eq '/haltme' ) { + redirect '/'; + halt; + } +}; +get '/haltme' => sub {"should not be there"}; + +hook 'after' => sub { + my $response = shift; + if ( request->path_info eq '/rewrite_me' ) { + $response->content("rewritten!"); + } +}; +get '/rewrite_me' => sub {"body should not be this one"}; + + +# some settings +set some_var => 1; +setting some_other_var => 1; +set multiple_vars => 4, can_be_set => 2; + +get '/config' => sub { + return + config->{some_var} . ' ' + . config->{some_other_var} . ' and ' + . setting('multiple_vars') + . setting('can_be_set'); +}; + +if ( $] >= 5.010 ) { + + # named captures + get + qr{/(?<class> usr | content | post )/(?<action> delete | find )/(?<id> \d+ )}x + => sub { + join( ":", sort %{ captures() } ); + }; +} + +# chained routes with pass +get '/user/**' => sub { + my $user = params->{splat}; + var user => $user->[0][0]; + pass; +}; + +get '/user/*/home' => sub { + my $user = var('user'); # should be set by the previous route + "hello $user"; +}; + +# post & dirname +post '/dirname' => sub { + dirname('/etc/passwd'); +}; + +# header +get '/header/:name/:value' => sub { + response_header param('name') => param('value'); + 1; +}; + +# push_header +get '/header/:name/:valueA/:valueB' => sub { + push_response_header param('name') => param('valueA'); + push_response_header param('name') => param('valueB'); + 1; +}; + +# header +get '/header_twice/:name/:valueA/:valueB' => sub { + response_header param('name') => param('valueA'); + response_header param('name') => param('valueB'); + 1; +}; + +# any +any [ 'get', 'post' ], '/any' => sub { + "Called with method " . request->method; +}; + +# true and false +get '/booleans' => sub { + join( ":", true, false ); +}; + +# mimes +get '/mime/:name' => sub { + mime->for_name( param('name') ); +}; + +# content_type +get '/content_type/:type' => sub { + content_type param('type'); + 1; +}; + +# prefix +prefix '/prefix' => sub { + get '/bar' => sub {'/prefix/bar'}; + prefix '/prefix1' => sub { + get '/bar' => sub {'/prefix/prefix1/bar'}; + }; + + prefix '/prefix2'; + get '/foo' => sub {'/prefix/prefix2/foo'}; +}; + +1; diff --git a/t/lib/TestPod.pm b/t/lib/TestPod.pm new file mode 100644 index 00000000..e9b99ec8 --- /dev/null +++ b/t/lib/TestPod.pm @@ -0,0 +1,85 @@ +package t::lib::TestPod; +use Dancer2; + +=head1 NAME + +TestPod + +=head2 ROUTES + +=over + +=cut + +=item get "/in_testpod" + +testpod + +=cut + +get '/in_testpod' => sub { + + # code; +}; + +=item get "/hello" + +testpod + +=cut + +get '/hello' => sub { + + # code; +}; + +=item post '/in_testpod/*' + +post in_testpod + +=cut + +post '/in_testpod/*' => sub { + return 'post in_testpod'; +}; + +=back + +=head2 SPECIALS + +=head3 PUBLIC + +=over + +=item get "/me:id" + +=cut + +get "/me:id" => sub { + + # code; +}; + +=back + +=head3 PRIVAT + +=over + +=item post "/me:id" + +post /me:id + +=cut + +post "/me:id" => sub { + + # code; +}; + +=back + +=cut + + +1; diff --git a/t/lib/TestTypeLibrary.pm b/t/lib/TestTypeLibrary.pm new file mode 100644 index 00000000..60329f0b --- /dev/null +++ b/t/lib/TestTypeLibrary.pm @@ -0,0 +1,8 @@ +package TestTypeLibrary; +use Type::Library -base, -declare => ('MyDate'); +use Type::Utils -all; +BEGIN { extends "Dancer2::Core::Types" }; + +declare MyDate, as StrMatch [qr{\d\d\d\d-\d\d-\d\d}]; + +1; diff --git a/t/lib/poc.pm b/t/lib/poc.pm new file mode 100644 index 00000000..456a223a --- /dev/null +++ b/t/lib/poc.pm @@ -0,0 +1,22 @@ +package poc; +use Dancer2; + +our $VERSION = '0.1'; + +use Dancer2::Plugin::Foo; + +set plugins => { + Foo => { + one => 1, + two => 2, + size => 4, + }, +}; + +get '/' => sub { + return 'hello there'; +}; + +get '/truncate' => sub { truncate_txt "hello there" }; + +true; diff --git a/t/lib/poc2.pm b/t/lib/poc2.pm new file mode 100644 index 00000000..2ab837fd --- /dev/null +++ b/t/lib/poc2.pm @@ -0,0 +1,32 @@ +package poc2; + +use strict; +use warnings; + +use Dancer2; +set logger => 'Capture'; + +BEGIN { +set plugins => { + Polite => { + smiley => '8-D', + }, +}; +} + +use PoC::Plugin::Polite ':app'; + +hook 'smileys' => sub { + send_error "Not in sudoers file. This incident will be reported"; +}; + +get '/' => sub { + add_smileys( 'make me a sandwich.' ); +}; + +get '/sudo' => sub { + hooked_smileys( 'make me a sandwich.' ); +}; + +1; + diff --git a/t/log_die_before_hook.t b/t/log_die_before_hook.t new file mode 100644 index 00000000..54f7658e --- /dev/null +++ b/t/log_die_before_hook.t @@ -0,0 +1,38 @@ +use Test::More; +use strict; +use warnings; +use Plack::Test; +use HTTP::Request::Common; +use Capture::Tiny 'capture_stderr'; +use Ref::Util qw<is_coderef>; + +{ + package App; + use Dancer2; + + set logger => 'console'; + + hook 'before' => sub { + die 'test die inside a before hook'; + print STDERR "error message not caught in the before hook\n"; + }; + + get '/' => sub { + print STDERR "error message not caught in the route handler\n"; + }; +} + +my $app = App->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + my $message = capture_stderr { $cb->( GET '/' ) }; + + like + $message, + qr/test die inside a before hook/, + 'Got error message when a before hook dies'; +}; + +done_testing; diff --git a/t/log_levels.t b/t/log_levels.t new file mode 100644 index 00000000..e8c5389e --- /dev/null +++ b/t/log_levels.t @@ -0,0 +1,128 @@ +#!perl + +use strict; +use warnings; +use Test::More tests => 8; +use Capture::Tiny 0.12 'capture_stderr'; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + + set logger => 'console'; + set log => 'debug'; + + get '/debug' => sub { + debug "debug msg\n"; + warning "warning msg\n"; + error "error msg\n"; + + set log => 'warning'; + + return 'debug'; + }; + + get '/warning' => sub { + debug "debug msg\n"; + warning "warning msg\n"; + error "error msg\n"; + + return 'warning'; + }; + + + get '/engine-warning' => sub { + # Ensure that the logger and warining level is going to be used by the engines, not just the application code + # Also ensure that the current log level, not the log level when the serialiser is created, is what counts. + set log => 'debug'; + set serializer => 'JSON'; + set template => 'Simple'; + set session => 'Simple'; + set log => 'warning'; + + foreach my $engine (qw(serializer session template)) { + app->engine($engine)->log_cb->($_ => "$engine $_ msg\n") for qw(debug warning error); + } + + return ["engine-warning"]; + }; +} + +my $app = App->to_app; + +test_psgi $app, sub { + my $cb = shift; + my $res; + + { + my $stderr = capture_stderr { $res = $cb->( GET '/debug' ) }; + + is( $res->code, 200, 'Successful response' ); + is( $res->content, 'debug', 'Correct content' ); + + like( + $stderr, + qr/ + ^ + # a debug line + \[App:\d+\] \s debug [^\n]+ \n + + # a warning line + \[App:\d+\] \s warning [^\n]+ \n + + # followed by an error line + \[App:\d+\] \s error [^\n]+ \n + $ + /x, + 'Log levels work', + ); + } + + { + my $stderr = capture_stderr { $res = $cb->( GET '/warning' ) }; + + is( $res->code, 200, 'Successful response' ); + is( $res->content, 'warning', 'Correct content' ); + + like( + $stderr, + qr/ + ^ + # a warning line + \[App:\d+\] \s warning [^\n]+ \n + + # followed by an error line + \[App:\d+\] \s error [^\n]+ \n + $ + /x, + 'Log levels work', + ); + } + { + my $stderr = capture_stderr { $res = $cb->( GET '/engine-warning' ) }; + + is( $res->code, 200, 'Successful response' ); + + like( + $stderr, + qr/ + ^ + # serializer engine should output warning and error only + \[App:\d+\] \s warning [^\n]+? serializer \s warning [^\n]+ \n + \[App:\d+\] \s error [^\n]+? serializer \s error [^\n]+ \n + + # session engine should output warning and error only + \[App:\d+\] \s warning [^\n]+? session \s warning [^\n]+ \n + \[App:\d+\] \s error [^\n]+? session \s error [^\n]+ \n + + # template engine should output warning and error only + \[App:\d+\] \s warning [^\n]+? template \s warning [^\n]+ \n + \[App:\d+\] \s error [^\n]+? template \s error [^\n]+ \n + $ + /x, + 'Log levels work', + ); + } +}; diff --git a/t/logger.t b/t/logger.t new file mode 100644 index 00000000..e45a5949 --- /dev/null +++ b/t/logger.t @@ -0,0 +1,116 @@ +use Test::More; +use strict; +use warnings; + +BEGIN { + + # Freeze time at Tue, 15-Jun-2010 00:00:00 GMT + *CORE::GLOBAL::time = sub { return 1276560000 } +} + + +my $_logs = []; + +{ + + package Dancer2::Logger::Test; + use Moo; + with 'Dancer2::Core::Role::Logger'; + + sub log { + my ( $self, $level, $message ) = @_; + push @$_logs, $self->format_message( $level, $message ); + } +} + +my $logger = Dancer2::Logger::Test->new( app_name => 'test' ); + +is $logger->log_level, 'debug'; +$logger->debug("foo"); + +# Hard to make caller(6) work when we deal with the logger directly, +# so do not check for a specific filename. +like $_logs->[0], qr{debug \@2010-06-1\d \d\d:\d\d:00> foo in }; + +subtest 'log level and capture' => sub { + use Dancer2::Logger::Capture; + use Dancer2; + + # NOTE: this will read the config.yml under t/ that defines log level as info + set logger => 'capture'; + + warning "Danger! Warning!"; + info "Tango, Foxtrot"; + debug "I like pie."; + + my $trap = dancer_app->engine('logger')->trapper; + my $msg = $trap->read; + delete $msg->[0]{'formatted'}; + delete $msg->[1]{'formatted'}; + is_deeply $msg, + [ + { + level => "warning", + message => "Danger! Warning!", + }, + { + level => "info", + message => "Tango, Foxtrot", + }, + ]; + + # each call to read cleans the trap + is_deeply $trap->read, []; +}; + +subtest 'logger enging hooks' => sub { + # before hook can change log level or message. + hook 'engine.logger.before' => sub { + my $logger = shift; # @_ = ( $level, @message_args ) + $_[0] = 'panic'; # eg. log all messages at the 'panic' level + }; + + my $str = "Thou shalt not pass"; + warning $str; + my $trap = dancer_app->engine('logger')->trapper; + my $msg = $trap->read; + delete $msg->[0]{'formatted'}; + is_deeply $msg, + [ + { + level => "panic", + message => $str, + }, + ]; +}; + +subtest 'logger file' => sub { + use Dancer2; + use File::Temp qw/tempdir/; + + my $dir = tempdir( CLEANUP => 1 ); + + set engines => { + logger => { + File => { + log_dir => $dir, + file_name => 'test', + } + } + }; + # XXX this sucks, we need to set the engine *before* the logger + # - Franck, 2013/08/03 + set logger => 'file'; + + warning "Danger! Warning!"; + + open my $log_file, '<', File::Spec->catfile($dir, 'test'); + my $txt = <$log_file>; + like $txt, qr/Danger! Warning!/; +}; +# Explicitly close the logger file handle for those systems that +# do not allow "open" files to be unlinked (Windows). GH#424. +my $log_engine = engine('logger'); +close $log_engine->fh; + +done_testing; diff --git a/t/logger_console.t b/t/logger_console.t new file mode 100644 index 00000000..77665d77 --- /dev/null +++ b/t/logger_console.t @@ -0,0 +1,34 @@ +use strict; +use warnings; +use Test::More; + +use Capture::Tiny 0.12 'capture_stderr'; +use Dancer2::Logger::Console; + +my $file = __FILE__; +my $l = Dancer2::Logger::Console->new( + app_name => 'test', + log_level => 'core' +); + +for my $level (qw{core debug info warning error}) { + my $stderr = capture_stderr { $l->$level("$level") }; + + # We are dealing directly with the logger, not through the DSL. + # Skipping 5 stack frames is likely to point to somewhere outside + # this test; however Capture::Tiny adds in several call frames + # (see below) to capture the output, giving a reasonable caller + # to test for + like $stderr, qr{$level in \Q$file\E l[.] 15}, "$level message sent"; +} +done_testing; + +__END__ + +# Stack frames involved where Role::Logger executes caller(5): +# Dancer2::Core::Role::Logger::format_message(Dancer2::Logger::Console=HASH(0x7f8e41029c60), "error", "error") called at lib/Dancer2/Logger/Console.pm line 10 +# Dancer2::Logger::Console::log(Dancer2::Logger::Console=HASH(0x7f8e41029c60), "error", "error") called at lib/Dancer2/Core/Role/Logger.pm line 183 +# Dancer2::Core::Role::Logger::error(Dancer2::Logger::Console=HASH(0x7f8e41029c60), "error") called at t/logger_console.t line 12 +# main::__ANON__() called at Capture/Tiny.pm line 369 +# eval {...} called at Capture/Tiny.pm line 369 +# Capture::Tiny::_capture_tee(0, 1, 0, 0, CODE(0x7f8e418181e0)) called at t/logger_console.t line 12 diff --git a/t/memory_cycles.t b/t/memory_cycles.t new file mode 100644 index 00000000..f388cf00 --- /dev/null +++ b/t/memory_cycles.t @@ -0,0 +1,29 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Plack::Test; + +eval { require Test::Memory::Cycle; 1; } + or plan skip_all => 'Test::Memory::Cycle not present'; + +{ + + package MyApp::Cycles; + use Dancer2; + + set auto_page => 1; + set serializer => 'JSON'; + + get '/**' => sub { + return { hello => 'world' }; + }; +} + +my $app = MyApp::Cycles->to_app; + +my $runner = Dancer2->runner; +Test::Memory::Cycle::memory_cycle_ok( $runner, "runner has no memory cycles" ); +Test::Memory::Cycle::memory_cycle_ok( $app, "App has no memory cycles" ); + +done_testing(); diff --git a/t/mime.t b/t/mime.t new file mode 100644 index 00000000..c65d1062 --- /dev/null +++ b/t/mime.t @@ -0,0 +1,42 @@ +use strict; +use warnings; + +use Test::More tests => 12; + +BEGIN { + use_ok 'Dancer2::Core::MIME'; +} + +my $mime = Dancer2::Core::MIME->new(); + +is_deeply( $mime->custom_types, {}, 'user defined mime_types are empty' ); + +$mime->add_type( foo => 'text/foo' ); +is_deeply( $mime->custom_types, { foo => 'text/foo' }, 'text/foo is saved' ); +is( $mime->for_name('foo'), 'text/foo', 'mime type foo is found' ); + +$mime->add_alias( bar => 'foo' ); +is( $mime->for_name('bar'), 'text/foo', 'mime type bar is found' ); + +is( $mime->for_file('foo.bar'), + 'text/foo', 'mime type for extension .bar is found' +); + +is( $mime->for_file('foobar'), + $mime->default, 'mime type for no extension is the default' +); + +is( $mime->add_alias( xpto => 'BAR' ), + 'text/foo', 'mime gets correctly lowercased for user types' +); + +is $mime->add_alias( xpto => 'SVG' ) => 'image/svg+xml', + 'mime gets correctly lowercased for system types'; + +is $mime->add_alias( zbr => 'baz' ) => $mime->default, + 'alias of unknown mime type gets default mime type'; + +is $mime->name_or_type("text/zbr") => "text/zbr", + 'name_or_type does not change if it seems a mime type string'; + +is $mime->name_or_type("svg") => "image/svg+xml", 'name_or_type knows svg'; diff --git a/t/multi_apps.t b/t/multi_apps.t new file mode 100644 index 00000000..12967d46 --- /dev/null +++ b/t/multi_apps.t @@ -0,0 +1,48 @@ +use strict; +use warnings; +use Test::More; +use Plack::Builder; +use Plack::Test; +use HTTP::Request::Common; + +{ + package MyTestWiki; + use Dancer2; + get '/' => sub { __PACKAGE__ }; + get '/wiki' => sub {'WIKI'}; + + package MyTestForum; + use Dancer2; + get '/' => sub { __PACKAGE__ }; + get '/forum' => sub {'FORUM'}; +} + +{ + my $app = builder { + mount '/wiki' => MyTestWiki->to_app; + mount '/forum' => MyTestForum->to_app; + }; + + isa_ok( $app, 'CODE', 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + is( $cb->( GET '/wiki' )->content, 'MyTestWiki', "Got wiki root" ); + is( $cb->( GET '/forum' )->content, 'MyTestForum', "Got forum root" ); + }; +} + +{ + my $app = Dancer2->psgi_app; + isa_ok( $app, 'CODE', 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + is( $cb->( GET '/wiki' )->content, 'WIKI', 'Got /wiki path' ); + is( $cb->( GET '/forum' )->content, 'FORUM', 'Got /forum path' ); + }; +} + +done_testing; diff --git a/t/multi_apps_forward.t b/t/multi_apps_forward.t new file mode 100644 index 00000000..4eabd35f --- /dev/null +++ b/t/multi_apps_forward.t @@ -0,0 +1,83 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 9; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App1; + use Dancer2; + + get '/' => sub {'App1'}; + + get '/forward' => sub { + forward '/'; + ::ok( 0, 'Foward not returning right away!' ); + }; + + get '/forward_to_new' => sub { + forward '/new'; + ::ok( 0, 'Foward not returning right away!' ); + }; +} + +{ + package App2; + use Dancer2; + get '/' => sub {'App2'}; + get '/new' => sub {'New'}; +} + +{ + # test each single app + my $app1 = App1->to_app; + test_psgi $app1, sub { + my $cb = shift; + is( $cb->( GET '/' )->code, 200, '[GET /] OK' ); + is( $cb->( GET '/' )->content, 'App1', '[GET /] OK content' ); + + is( $cb->( GET '/forward' )->code, 200, '[GET /forward] OK' ); + is( + $cb->( GET '/forward' )->content, + 'App1', + '[GET /forward] OK content' + ); + + is( + $cb->( GET '/forward_to_new' )->code, + 404, + 'Cannot find /new', + ); + }; + + my $app2 = App2->to_app; + test_psgi $app2, sub { + my $cb = shift; + is( $cb->( GET '/' )->code, 200, '[GET /] OK' ); + is( $cb->( GET '/' )->content, 'App2', '[GET /] OK content' ); + }; +} + +note 'Old format using psgi_app to loop over multiple apps'; { + # test global + my $app = Dancer2->psgi_app; + test_psgi $app, sub { + my $cb = shift; + + is( + $cb->( GET '/forward_to_new' )->code, + 200, + '[GET /forward_to_new] OK', + ); + + is( + $cb->( GET '/forward_to_new' )->content, + 'New', + '[GET /forward_to_new] OK content', + ); + }; +} + diff --git a/t/multiapp_template_hooks.t b/t/multiapp_template_hooks.t new file mode 100644 index 00000000..945673fb --- /dev/null +++ b/t/multiapp_template_hooks.t @@ -0,0 +1,208 @@ +#!perl + +use strict; +use warnings; + +use File::Spec; +use File::Basename 'dirname'; +use Test::More tests => 32; +use Plack::Test; +use HTTP::Request::Common; + +my $views = File::Spec->rel2abs( + File::Spec->catfile( dirname(__FILE__), 'views' ) +); + +my %called_hooks = (); +my $hook_name = 'engine.template.before_render'; + +{ + package App1; + use Dancer2; + + set views => $views; + + hook before => sub { $called_hooks{'App1'}{'before'}++ }; + + hook before_template => sub { + my $tokens = shift; + ::isa_ok( $tokens, 'HASH', '[App1] Tokens' ); + + my $app = app; + + ::isa_ok( $app, 'Dancer2::Core::App', 'Got app object inside App1' ); + + # we accept anything that goes to App1, even if not only to App1 + ::like( + $tokens->{'request'}->param('to'), + qr/^App1/, + 'Request reached to correct App (App1)', + ); + + ::is( + scalar @{ $app->template_engine->hooks->{$hook_name} }, + 1, + 'App1 has a single before_template hook defined', + ); + + $tokens->{'myname'} = 'App1'; + $called_hooks{'App1'}{'before_template'}++; + }; + + get '/' => sub { + template beforetemplate => { it => 'App1' }, { layout => undef }; + }; +} + +{ + package App2; + use Dancer2; + + set views => $views; + + hook before => sub { $called_hooks{'App2'}{'before'}++ }; + + hook before_template => sub { + my $tokens = shift; + ::isa_ok( $tokens, 'HASH', '[App2] Tokens' ); + + my $app = app; + ::isa_ok( $app, 'Dancer2::Core::App', 'Got app object inside App2' ); + + ::is( + $tokens->{'request'}->param('to'), + 'App2', + 'Request reached to correct App (App2)', + ); + + ::is( + scalar @{ $app->template_engine->hooks->{$hook_name} }, + 1, + 'App2 has a single before_template hook defined', + ); + + $tokens->{'myname'} = 'App2'; + $called_hooks{'App2'}{'before_template'}++; + }; + + get '/' => sub { + template beforetemplate => { it => 'App2' }, { layout => undef }; + }; + + get '/2' => sub { + template beforetemplate => { it => 'App2' }, { layout => undef }; + }; +} + +note 'Check App1 only calls first hook, not both'; { + # clear + %called_hooks = (); + + my $app = App1->to_app; + isa_ok( $app, 'CODE', 'Got app for test' ); + + test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/?to=App1' ); + + is( $res->code, 200, '[GET /] Successful' ); + + is( + $res->content, + "App is App1, again, it is App1\n", + '[GET /] Correct content', + ); + + is_deeply( + \%called_hooks, + { App1 => { before => 1, before_template => 1 } }, + 'Only App1\'s before_template hook was called', + ); + }; +} + +note 'Check App2 only calls second hook, not both'; { + # clear + %called_hooks = (); + + my $app = App2->to_app; + isa_ok( $app, 'CODE', 'Got app for test' ); + + test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/?to=App2' ); + + is( $res->code, 200, '[GET /] Successful' ); + + is( + $res->content, + "App is App2, again, it is App2\n", + '[GET /] Correct content', + ); + + is_deeply( + \%called_hooks, + { App2 => { before => 1, before_template => 1 } }, + 'Only App2\'s before_template hook was called', + ); + }; +} + +note 'Check both apps only call the first hook (correct app), not both'; { + # clear + %called_hooks = (); + + my $app = Dancer2->psgi_app; + isa_ok( $app, 'CODE', 'Got app for test' ); + + test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/?to=App1:App2' ); + + is( $res->code, 200, '[GET /] Successful' ); + + is( + $res->content, + "App is App1, again, it is App1\n", + '[GET /] Correct content', + ); + + is_deeply( + \%called_hooks, + { App1 => { before => 1, before_template => 1 } }, + 'Only App1\'s before_template hook was called (full PSGI app)', + ); + }; +} + +note 'Check both apps only call the second hook (correct app), not both'; { + # clear + %called_hooks = (); + + my $app = Dancer2->psgi_app; + isa_ok( $app, 'CODE', 'Got app for test' ); + + test_psgi $app, sub { + my $cb = shift; + my $res = $cb->( GET '/2?to=App2' ); + + is( $res->code, 200, '[GET /2] Successful' ); + + is( + $res->content, + "App is App2, again, it is App2\n", + '[GET /2] Correct content', + ); + + # INFO: %called_hooks does not contain any counts for App1; + # no routes match, so no hooks are called. + is_deeply( + \%called_hooks, + { + App2 => { before => 1, before_template => 1 }, + }, + 'Only App2\'s before_template hook was called (full PSGI app)', + ); + }; +} + diff --git a/t/named_apps.t b/t/named_apps.t new file mode 100644 index 00000000..83cc5dfa --- /dev/null +++ b/t/named_apps.t @@ -0,0 +1,40 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; + +{ + package Foo; + use Dancer2; + + hook before => sub { vars->{foo} = 'foo' }; + + post '/foo' => sub { + return vars->{foo} . 'foo' . vars->{baz}; + }; +} + +{ + package Bar; + use Dancer2 appname => 'Foo'; # Add routes and hooks to Foo. + + hook before => sub { vars->{baz} = 'baz' }; + + post '/bar' => sub { + return vars->{foo} . 'bar' . vars->{baz}; + } +} + +my $app = Dancer2->psgi_app; + +test_psgi $app, sub { + my $cb = shift; + for my $path ( qw/foo bar/ ) { + my $res = $cb->( POST "/$path" ); + is $res->content, "foo${path}baz", + "Got app content path $path"; + } +}; + +done_testing; diff --git a/t/no_default_middleware.t b/t/no_default_middleware.t new file mode 100644 index 00000000..8b91d216 --- /dev/null +++ b/t/no_default_middleware.t @@ -0,0 +1,59 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use Plack::Builder; +use HTTP::Request::Common; + +use Plack::Middleware::Head; +use Plack::Middleware::FixMissingBodyInRedirect; + +# No default middleware wrappers + +{ + package MyTestApp; + use Dancer2; + set no_default_middleware => 1; + + get '/' => sub { return 'some content' }; + + get '/redirect' => sub { redirect '/' }; +} + + +subtest 'Head' => sub { + my $plain = Plack::Test->create( MyTestApp->to_app ); + my $res = $plain->request( HEAD '/' ); + ok( length( $res->content ) > 0, 'HEAD request on unwrapped app has content' ); + + my $test = Plack::Test->create( + builder { + enable 'Head'; + MyTestApp->to_app; + } + ); + my $response = $test->request( HEAD '/' ); + is( length( $response->content ), 0, 'HEAD request on wrapped app has no content' ); + + is( $res->header('Content-Length'), + $response->header('Content-Length'), + 'HEAD requests have consistent content length header' + ); +}; + +subtest 'FixMissingBodyInRedirect' => sub { + my $plain = Plack::Test->create( MyTestApp->to_app ); + my $res = $plain->request( GET '/redirect' ); + is( length( $res->content ), 0, 'GET request that redirects on unwrapped app has no content' ); + + my $test = Plack::Test->create( + builder { + enable 'FixMissingBodyInRedirect'; + MyTestApp->to_app; + } + ); + my $response = $test->request( GET '/redirect' ); + ok( length( $response->content ) > 0, 'GET request that redirects on wrapped app has content' ); +}; + +done_testing; diff --git a/t/plugin2/basic-2.t b/t/plugin2/basic-2.t new file mode 100644 index 00000000..a8fb8b92 --- /dev/null +++ b/t/plugin2/basic-2.t @@ -0,0 +1,37 @@ +use strict; +use warnings; + +use Test::More tests => 8; +use Plack::Test; +use HTTP::Request::Common; + +use lib 't/lib'; +use poc2; + +my $test = Plack::Test->create( poc2->to_app ); + +note "poc2 root"; { + my $res = $test->request( GET '/' ); + ok $res->is_success; + + my $content = $res->content; + like $content, qr/please/; + like $content, qr/8-D/; +} + +note "pos2 goodbye"; { + my $res = $test->request( GET '/goodbye' ); + ok $res->is_success; + + my $content = $res->content; + like $content, qr/farewell/; + like $content, qr/please/; +} + +note "pos2 hooked"; { + my $res = $test->request( GET '/sudo' ); + ok ! $res->is_success; + + my $content = $res->content; + like $content, qr/Not in sudoers file/; +} diff --git a/t/plugin2/basic.t b/t/plugin2/basic.t new file mode 100644 index 00000000..1cdec462 --- /dev/null +++ b/t/plugin2/basic.t @@ -0,0 +1,31 @@ +use strict; +use warnings; + +use Test::More tests => 6; +use Plack::Test; +use HTTP::Request::Common; + +use lib 't/lib'; +use poc; + +my $test = Plack::Test->create( poc->to_app ); + +note "poc root"; { + my $res = $test->request( GET '/' ); + ok $res->is_success; + + my $content = $res->content; + like $content, qr/added by plugin/; + + like $content, qr/something:1/, 'config parameters are read'; + + like $content, qr/Bar loaded/, 'Plugin Bar has been loaded'; + + like $content, qr/bazbazbaz/, 'Foo has a copy of Bar'; +} + +note "poc truncate"; { + my $res = $test->request( GET '/truncate' ); + like $res->content, qr'helladd'; +} + diff --git a/t/plugin2/define-keywords.t b/t/plugin2/define-keywords.t new file mode 100644 index 00000000..b02ef9cb --- /dev/null +++ b/t/plugin2/define-keywords.t @@ -0,0 +1,28 @@ +use strict; +use warnings; + +use lib 't/lib'; + +use Test::More; + +plan skip_all => 'Perl >=5.12 required' if $] < 5.012; + +plan tests => 2; + +use Dancer2; +use Dancer2::Plugin::DefineKeywords; + +my $plugin = Dancer2::Plugin::DefineKeywords->new( app => undef ); + +subtest "keywords are registered" => sub { + for my $keyword ( @::expected_keywords ) { + ok( ( scalar grep { $_ eq $keyword } keys %{ $plugin->keywords } ), $keyword ); + } +}; + +subtest "keywords are recognized" => sub { + is foo() => 'foo', 'foo'; + is bar() => 'bar', 'bar'; + is quux() => 'quux', 'quux'; +}; + diff --git a/t/plugin2/find_plugin.t b/t/plugin2/find_plugin.t new file mode 100644 index 00000000..01555eee --- /dev/null +++ b/t/plugin2/find_plugin.t @@ -0,0 +1,104 @@ +use strict; +use warnings; +use Test::More 'tests' => 3; +use Plack::Test; +use HTTP::Request::Common; + +{ + package Dancer2::Plugin::Foo; + use Dancer2::Plugin; + + BEGIN { + has 'foo_message' => ( + 'is' => 'ro', + 'default' => sub {'foo'}, + ); + + plugin_keywords('foo_message'); + } +} + +{ + package Dancer2::Plugin::Bar; + use Dancer2::Plugin; + + BEGIN { + has 'bar_message' => ( + 'is' => 'ro', + 'lazy' => 1, + 'default' => sub { + my $self = shift; + ::isa_ok( $self, 'Dancer2::Plugin::Bar' ); + + my $foo = $self->find_plugin('Dancer2::Plugin::Foo') + or Carp::croak('Cannot find Dancer2::Plugin::Foo'); + + ::isa_ok( $foo, 'Dancer2::Plugin::Foo' ); + ::can_ok( $foo, 'foo_message' ); + return $foo->foo_message . ':bar'; + } + ); + + plugin_keywords('bar_message'); + } +} + +{ + package AppWithFoo; + use Dancer2; + use Dancer2::Plugin::Foo; + get '/' => sub { return foo_message() }; +} + +{ + package AppWithBar; + use Dancer2; + use Dancer2::Plugin::Bar; + set 'logger' => 'Capture'; + get '/' => sub { return bar_message() }; +} + +{ + package AppWithFooAndBar; + use Dancer2; + use Dancer2::Plugin::Foo; + use Dancer2::Plugin::Bar; + get '/' => sub { return bar_message() }; +} + +subtest 'Baseline' => sub { + my $test = Plack::Test->create( AppWithFoo->to_app ); + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful response' ); + is( $res->content, 'foo', 'Foo plugin works correctly' ); +}; + +subtest 'When parent plugin not available' => sub { + my $test = Plack::Test->create( AppWithBar->to_app ); + my $res = $test->request( GET '/' ); + + ok( !$res->is_success, 'Response failed' ); + + my $trap = AppWithBar::app->config()->{'logger'}; + isa_ok( $trap, 'Dancer2::Logger::Capture' ); + + my $trapper = $trap->trapper; + my $logs = $trapper->read; + isa_ok( $logs, 'ARRAY', 'Found logs' ); + is( scalar @{$logs}, 1, 'One log message' ); + + my $message = $logs->[0]; + is( $message->{'level'}, 'error' ); + like( + $message->{'message'}, + qr{\QRoute exception: Cannot find Dancer2::Plugin::Foo\E}, + 'Correct error', + ); +}; + +subtest 'When both parent and child plugins available' => sub { + my $test = Plack::Test->create( AppWithFooAndBar->to_app ); + my $res = $test->request( GET '/' ); + ok( $res->is_success, 'Successful response' ); + is( $res->content, 'foo:bar', 'Bar plugin found Foo and worked' ); +}; diff --git a/t/plugin2/from-config.t b/t/plugin2/from-config.t new file mode 100644 index 00000000..15584e4f --- /dev/null +++ b/t/plugin2/from-config.t @@ -0,0 +1,92 @@ +use strict; +use warnings; + +use Test::More tests => 8; + +{ +package Dancer2::Plugin::FromConfig; + +use Dancer2::Plugin; + +BEGIN { +has one => ( + is => 'ro', + from_config => 1, +); + +has three => ( + is => 'ro', + from_config => 'two.three', +); + +has four => ( + is => 'ro', + from_config => 1, + default => sub { 'quatre' }, +); + +has five => ( + is => 'ro', + from_config => sub { 'cinq' }, +); + +has six => ( + is => 'ro', + from_config => sub { 'six' }, + default => sub { 'AH!' }, + plugin_keyword => 1, +); + +has [qw(seven eight)] => ( + is => 'ro', + from_config => 1, + plugin_keyword => 1, +); + +eval { + has [qw(nine ten)] => ( + is => 'ro', + from_config => 1, + plugin_keyword => ['nine', 'ten'], + ); +}; +our $plugin_keyword_exception = $@; + +plugin_keywords qw/ one three four five /; + +} +} + +{ + package MyApp; + + use Dancer2; + + use Dancer2::Plugin::FromConfig; + + set plugins => { + FromConfig => { + one => 'un', + two => { + three => 'trois', + }, + seven => 'sept', + eight => 'huit', + } + }; + + + Test::More::is one() => 'un', 'from config'; + Test::More::is three() => 'trois', 'from config, nested'; + Test::More::is four() => 'quatre', 'nothing in config, default value'; + Test::More::is five() => 'cinq', 'from_config a coderef'; + Test::More::is six() => 'AH!', 'from_config a coderef, no override'; + Test::More::is seven() => 'sept', 'from_config, defined two fields at once #1'; + Test::More::is eight() => 'huit', 'from_config, defined two fields at once #2'; + Test::More::ok $Dancer2::Plugin::FromConfig::plugin_keyword_exception, + "defining two fields simultaneously with multiple plugin_keyword values" + . " is disallowed"; +} + + + diff --git a/t/plugin2/hooks.t b/t/plugin2/hooks.t new file mode 100644 index 00000000..487e0d2d --- /dev/null +++ b/t/plugin2/hooks.t @@ -0,0 +1,82 @@ +use strict; +use warnings; + +use Test::More tests => 3; +use Plack::Test; +use HTTP::Request::Common; + +{ + package Dancer2::Plugin::FooDetector; + + use Dancer2::Plugin; + + plugin_hooks 'foo'; + + + sub BUILD { + my $plugin = shift; + + $plugin->app->add_hook( + Dancer2::Core::Hook->new( + name => 'after', + code => sub { + $plugin->app->execute_hook( 'plugin.foodetector.foo' ) + if $_[0]->content =~ /foo/; + } + ) ); + } +} + +{ + package PoC; + + use Dancer2; + + use Dancer2::Plugin::FooDetector; + + my $hooked = 'nope'; + my $counter = 0; + + hook 'plugin.foodetector.foo' => sub { + $counter++; + $hooked = 'hooked'; + }; + + get '/' => sub { + "saying foo triggers the hook" + }; + + get 'meh' => sub { 'meh' }; + + get '/hooked' => sub { $hooked }; + get '/counter' => sub { $counter }; +} + + +my $test = Plack::Test->create( PoC->to_app ); + +subtest 'initial state' => sub { + ok $test->request( GET '/meh' )->is_success; + my $res = $test->request( GET '/hooked' ); + ok $res->is_success; + is $res->content, 'nope'; + is $test->request( GET '/counter' )->content, '0'; +}; + +subtest 'trigger hook' => sub { + ok $test->request( GET '/' )->is_success; + my $res = $test->request( GET '/hooked' ); + ok $res->is_success; + is $res->content, 'hooked'; + is $test->request( GET '/counter' )->content, '1'; +}; + +# GH #1018 - ensure hooks are called the correct number of times +subtest 'execute hook counting' => sub { + ok $test->request( GET '/' )->is_success; + my $res = $test->request( GET '/hooked' ); + ok $res->is_success; + is $res->content, 'hooked'; + is $test->request( GET '/counter' )->content, '2'; +}; + diff --git a/t/plugin2/inside-plugin.t b/t/plugin2/inside-plugin.t new file mode 100644 index 00000000..0b5d43e1 --- /dev/null +++ b/t/plugin2/inside-plugin.t @@ -0,0 +1,73 @@ +use strict; +use warnings; + +use Test::More; + +BEGIN { + package Dancer2::Plugin::InsidePlugin; + + use Dancer2::Plugin; + + has inside => ( + is => 'ro', + lazy => 1, + default => sub { + my $app = shift; + return $app->plugin->config->{ja}; + }, + ); +} + +BEGIN { + package Dancer2::Plugin::TestPlugin; + + use Dancer2::Plugin; + + has inside_plugin => ( + is => 'ro', + default => sub { + scalar $_[0]->app->with_plugin( 'InsidePlugin' ) + }, + handles => [ 'inside' ], + ); +} + +{ + package MyApp; + + use Dancer2; + + use Dancer2::Plugin::TestPlugin; + + set plugins => { + InsidePlugin => { + 'ja' => 'da', + }, + TestPlugin => { + 'nein' => 'ne', + } + }; +} + +# check whether both plugins are registered +my $app = MyApp::app(); +my $plugins = $app->plugins; +my $plugin_ct = scalar(@$plugins); + +ok ($plugin_ct == 2, 'Test number of plugins.') + || diag "Found $plugin_ct plugins instead of 2."; + +my $test_plugin = $app->with_plugin('TestPlugin'); +my $inside_plugin = $test_plugin->inside_plugin; + +isa_ok( $test_plugin, 'Dancer2::Plugin::TestPlugin' ); +isa_ok( $inside_plugin, 'Dancer2::Plugin::InsidePlugin' ); + +# test configuration values +is $test_plugin->config->{nein} => 'ne', 'Test config of TestPlugin.' + or diag "Found instead of expected 'ne': ", $test_plugin->config->{nein}; + +is $inside_plugin->config->{ja} => 'da', 'Test config of InsidePlugin.' + or diag "Found instead of expected 'da': ", $inside_plugin->config->{ja}; + +done_testing; diff --git a/t/plugin2/keywords-hooks-namespace.t b/t/plugin2/keywords-hooks-namespace.t new file mode 100644 index 00000000..f6e6ebae --- /dev/null +++ b/t/plugin2/keywords-hooks-namespace.t @@ -0,0 +1,63 @@ +BEGIN { + package Dancer2::Plugin::Plugin1; + use Dancer2::Plugin; + + has one => ( + is => 'ro', + default => sub { 'uno' }, + plugin_keyword => 1, + ); + + plugin_hooks 'un'; +} + +BEGIN { + package Dancer2::Plugin::Plugin2; + use Dancer2::Plugin; + + has two => ( + is => 'ro', + default => sub { 'dos' }, + plugin_keyword => 1, + ); + + plugin_hooks 'deux'; + +} + +use Test::More; + +my %tests = ( + 'Plugin1' => { keywords => [ 'one' ], hooks => [ 'un' ] }, + 'Plugin2' => { keywords => [ 'two' ], hooks => [ 'deux' ] }, +); + +subtest $_ => sub { + my $plugin = join '::', 'Dancer2', 'Plugin', $_; + + is_deeply [ keys %{ $plugin->keywords } ] => $tests{$_}{keywords}, 'keywords'; + is_deeply [ @{ $plugin->ClassHooks } ] => $tests{$_}{hooks}, 'hooks'; + +} for sort keys %tests; + + +subtest app_side => sub { + package MyApp; + + use Dancer2 '!pass'; + use Dancer2::Plugin::Plugin1; + use Dancer2::Plugin::Plugin2; + + use Test::More; + + Test::More::is one() => 'uno', 'from plugin1'; + Test::More::is two() => 'dos', 'from plugin2'; + + is_deeply { map { ref $_ => [ keys %{ $_->hooks } ] } @{ app()->plugins } }, + { + 'Dancer2::Plugin::Plugin1' => [ 'plugin.plugin1.un' ], + 'Dancer2::Plugin::Plugin2' => [ 'plugin.plugin2.deux' ], + }; +}; + +done_testing(); diff --git a/t/plugin2/memory_cycles.t b/t/plugin2/memory_cycles.t new file mode 100644 index 00000000..ff1d31ba --- /dev/null +++ b/t/plugin2/memory_cycles.t @@ -0,0 +1,36 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Plack::Test; + +eval { require Test::Memory::Cycle; 1; } + or plan skip_all => 'Test::Memory::Cycle not present'; + +{ + package Dancer2::Plugin::Null; + use Dancer2::Plugin; + plugin_keywords 'nothing'; + sub nothing {1} +} + +{ + package MyApp::Cycles; + use Dancer2; + use Dancer2::Plugin::Null; + + set auto_page => 1; + set serializer => 'JSON'; + + get '/**' => sub { + return { hello => 'world' }; + }; +} + +my $app = MyApp::Cycles->to_app; + +my $runner = Dancer2->runner; +Test::Memory::Cycle::memory_cycle_ok( $runner, "runner has no memory cycles" ); +Test::Memory::Cycle::memory_cycle_ok( $app, "App has no memory cycles" ); + +done_testing(); diff --git a/t/plugin2/no-app-munging.t b/t/plugin2/no-app-munging.t new file mode 100644 index 00000000..26f34add --- /dev/null +++ b/t/plugin2/no-app-munging.t @@ -0,0 +1,23 @@ +use strict; +use warnings; + +use Test::More tests => 1; + +{ + package Dancer2::Plugin::Foo; + + use Dancer2::Plugin; +} + +{ + package MyRandomModule; + + use Test::More; + + sub app { fail "shouldn't try to run it" }; + + use Dancer2::Plugin::Foo (); + +} + +pass "we survived!"; diff --git a/t/plugin2/no-clobbering.t b/t/plugin2/no-clobbering.t new file mode 100644 index 00000000..e5d5cd5f --- /dev/null +++ b/t/plugin2/no-clobbering.t @@ -0,0 +1,63 @@ +use strict; +use warnings; + +use Test::More; + +BEGIN { + package + Dancer2::Plugin::Foo; + + use Dancer2::Plugin; + + plugin_keywords 'from_config', 'from_plugin_setting', 'from_indirect'; + + sub from_config :PluginKeyword { + $_[0]->config->{oops}; + } + + sub from_plugin_setting :PluginKeyword { + plugin_setting()->{oops}; + } + + sub from_indirect :PluginKeyword { + _indirect(); + } + + sub _indirect { + plugin_setting()->{oops}; + } +} + +{ + package + Alpha; + + use Dancer2 '!pass'; + use Test::More; + + dancer_app->config->{plugins}{Foo}{oops} = 'alpha'; + + use Dancer2::Plugin::Foo; + + is from_config() => 'alpha', 'alpha from config'; + is from_plugin_setting() => 'alpha', 'alpha from plugin_setting'; + is from_indirect() => 'alpha', 'alpha from indirect'; + +} +{ + package + Beta; + + use Dancer2 '!pass'; + use Test::More; + + dancer_app->config->{plugins}{Foo}{oops} = 'beta'; + + use Dancer2::Plugin::Foo; + + is from_config() => 'beta', 'beta from config'; + is from_plugin_setting() => 'beta', 'beta from plugin_setting'; + is from_indirect() => 'beta', 'beta from indirect'; +} + +done_testing(); diff --git a/t/plugin2/no-config.t b/t/plugin2/no-config.t new file mode 100644 index 00000000..1d4abaee --- /dev/null +++ b/t/plugin2/no-config.t @@ -0,0 +1,38 @@ +use strict; +use warnings; + +use Test::More tests => 1; + +BEGIN { + package Dancer2::Plugin::Foo; + + use Dancer2::Plugin; + + has bar => ( + is => 'ro', + from_config => 1, + ); + + has baz => ( + is => 'ro', + default => sub { $_[0]->config->{baz} }, + ); + + plugin_keywords qw/ bar baz /; + +} + +{ + package MyApp; + + use Dancer2; + use Dancer2::Plugin::Foo; + + bar(); + + baz(); + +} + +pass "we survived bar() and baz()"; + diff --git a/t/plugin2/with-plugins.t b/t/plugin2/with-plugins.t new file mode 100644 index 00000000..e71604c6 --- /dev/null +++ b/t/plugin2/with-plugins.t @@ -0,0 +1,71 @@ +use strict; +use warnings; + +use Test::More tests => 8; +use Scalar::Util qw/ refaddr /; + +{ + package Dancer2::Plugin::Foo; + use Dancer2::Plugin; +} + +{ + package Dancer2::Plugin::Bar; + use Dancer2::Plugin; +} + +{ + package Dancer2::Plugin::Baz; + use Dancer2::Plugin; +} + +{ + package MyApp; + use Dancer2; +} + +my $app = MyApp::app(); + +my $plugin = $app->with_plugin('Foo'); + +isa_ok $plugin => 'Dancer2::Plugin'; + +cmp_ok @{ $app->plugins }, '==', 1, "app has one plugin"; +cmp_ok ref($app->plugins->[0]), 'eq', 'Dancer2::Plugin::Foo' , "app has plugin Foo"; + +my $same_plugin = $app->with_plugin('Foo'); + +is refaddr $same_plugin => refaddr $plugin, + "plugin is not redefined"; + +cmp_ok @{ $app->plugins }, '==', 1, "app still has one plugin"; +cmp_ok ref($app->plugins->[0]), 'eq', 'Dancer2::Plugin::Foo' , "app has plugin Foo"; + +subtest "adding plugin Bar" => sub { + my $plugin = $app->with_plugin('Bar'); + + isa_ok $plugin => 'Dancer2::Plugin'; + + cmp_ok @{ $app->plugins }, '==', 2, "app has two plugins"; + + cmp_ok ref($app->plugins->[0]), 'eq', 'Dancer2::Plugin::Foo', + "app has plugin Foo"; + cmp_ok ref($app->plugins->[1]), 'eq', 'Dancer2::Plugin::Bar', + "app has plugin Bar"; +}; + +subtest "adding as an object" => sub { + my $plugin = Dancer2::Plugin::Baz->new( app => $app ); + my $p = $app->with_plugin($plugin); + + is refaddr $p => refaddr $plugin, "it's the same"; + + cmp_ok @{ $app->plugins }, '==', 3, "app has three plugins"; + + cmp_ok ref($app->plugins->[0]), 'eq', 'Dancer2::Plugin::Foo', + "app has plugin Foo"; + cmp_ok ref($app->plugins->[1]), 'eq', 'Dancer2::Plugin::Bar', + "app has plugin Bar"; + cmp_ok ref($app->plugins->[2]), 'eq', 'Dancer2::Plugin::Baz', + "app has plugin Baz"; +}; diff --git a/t/plugin_import.t b/t/plugin_import.t new file mode 100644 index 00000000..e865afa1 --- /dev/null +++ b/t/plugin_import.t @@ -0,0 +1,60 @@ +# plugin_import.t + +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + use Dancer2; + use lib 't/lib'; + use Dancer2::Plugin::PluginWithImport; + + get '/test' => sub { + dancer_plugin_with_import_keyword; + }; +} + +my $app = __PACKAGE__->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + is( + $cb->( GET '/test' )->content, + 'dancer_plugin_with_import_keyword', + 'the plugin exported its keyword', + ); +}; + +is_deeply( + Dancer2::Plugin::PluginWithImport->stuff, + { 'Dancer2::Plugin::PluginWithImport' => 'imported' }, + "the original import method of the plugin is still there" +); + +subtest 'import flags' => sub { + eval " + package Dancer2::Plugin::Some::Plugin1; + use Dancer2::Plugin ':no_dsl'; + + register 'foo' => sub { request }; + "; + like $@, qr{Bareword "request" not allowed while "strict subs"}, + "with :no_dsl, the Dancer's dsl is not imported."; + + eval " + package Dancer2::Plugin::Some::Plugin2; + use Dancer2::Plugin; + + register 'foo' => sub { request }; + "; + is $@, '', "without any import flag, the DSL is imported"; + + +}; + +done_testing; diff --git a/t/plugin_multiple_apps.t b/t/plugin_multiple_apps.t new file mode 100644 index 00000000..7e545515 --- /dev/null +++ b/t/plugin_multiple_apps.t @@ -0,0 +1,34 @@ +# plugin_multiple_apps.t + +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + package App; + + BEGIN { + use Dancer2; + set session => 'Simple'; + } + + use lib '.'; + use t::lib::SubApp1 with => { session => engine('session') }; + + use t::lib::SubApp2 with => { session => engine('session') }; +} + +my $app = Dancer2->psgi_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + is( $cb->( GET '/subapp1' )->content, 1, '/subapp1' ); + is( $cb->( GET '/subapp2' )->content, 2, '/subapp2' ); +}; + +done_testing; diff --git a/t/plugin_register.t b/t/plugin_register.t new file mode 100644 index 00000000..44cad9cc --- /dev/null +++ b/t/plugin_register.t @@ -0,0 +1,56 @@ +use strict; +use warnings; + +use Test::More import => ['!pass']; +use Test::Fatal; + +subtest 'reserved keywords' => sub { + use Dancer2::Plugin; + like( + exception { + register dance => sub {1} + }, + qr/You can't use 'dance', this is a reserved keyword/, + "Can't use Dancer2's reserved keywords", + ); + + like( + exception { + register '1function' => sub {1} + }, + qr/You can't use '1function', it is an invalid name/, + "Can't use invalid names for keywords", + ); +}; + +subtest 'plugin reserved keywords' => sub { + { + + package Foo; + use Dancer2::Plugin; + + Test::More::is( + Test::Fatal::exception { + register 'foo_method' => sub {1} + }, + undef, + "can register a new keyword", + ); + } + + { + + package Bar; + use Dancer2::Plugin; + + Test::More::like( + Test::Fatal::exception { + register 'foo_method' => sub {1} + }, + qr{can't use foo_method, this is a keyword reserved by Foo}, + "can't register a keyword already registered by another plugin", + ); + } +}; + +done_testing; diff --git a/t/plugin_syntax.t b/t/plugin_syntax.t new file mode 100644 index 00000000..aac03618 --- /dev/null +++ b/t/plugin_syntax.t @@ -0,0 +1,184 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; +use JSON::MaybeXS; +use Ref::Util qw<is_coderef>; + +subtest 'global and route keywords' => sub { + { + package App1; + use Dancer2; + use lib 't/lib'; + use Dancer2::Plugin::FooPlugin; + + sub location {'/tmp'} + + get '/' => sub { + foo_wrap_request->env->{'PATH_INFO'}; + }; + + get '/app' => sub { app->name }; + + get '/plugin_setting' => sub { to_json(p_config) }; + + foo_route; + } + + my $app = App1->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + is( + $cb->( GET '/' )->content, + '/', + 'route defined by a plugin', + ); + + is( + $cb->( GET '/foo' )->content, + 'foo', + 'DSL keyword wrapped by a plugin', + ); + + is( + _normalize($cb->( GET '/plugin_setting' )->content), + _normalize(encode_json( { plugin => '42' } )), + 'plugin_setting returned the expected config' + ); + + is( + $cb->( GET '/app' )->content, + 'App1', + 'app name is correct', + ); + }; +}; + +subtest 'plugin old syntax' => sub { + { + package App2; + use Dancer2; + use lib 't/lib'; + use Dancer2::Plugin::DancerPlugin; + + around_get; + } + + my $app = App2->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + is( + $cb->( GET '/foo/plugin' )->content, + 'foo plugin', + 'foo plugin', + ); + }; +}; + +subtest caller_dsl => sub { + my $app = App1->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + is( + $cb->( GET '/sitemap' )->content, + '^\/$, ^\/app$, ^\/foo$, ^\/foo\/plugin$, ^\/plugin_setting$, ^\/sitemap$', + 'Correct content', + ); + }; +}; + +subtest 'hooks in plugins' => sub { + my $counter = 0; + + { + package App3; + use Dancer2; + use lib 't/lib'; + use Dancer2::Plugin::OnPluginImport; + use Dancer2::Plugin::Hookee; + use Dancer2::Plugin::EmptyPlugin; + + hook 'third_hook' => sub { + var( hook => 'third hook' ); + }; + + hook 'start_hookee' => sub { + 'this is the start hook'; + }; + + get '/hook_with_var' => sub { + some_other(); # executes 'third_hook' + ::is var('hook') => 'third hook', "Vars preserved from hooks"; + }; + + get '/hooks_plugin' => sub { + $counter++; + some_keyword(); # executes 'start_hookee' + 'hook for plugin'; + }; + + get '/hook_returns_stuff' => sub { + some_keyword(); # executes 'start_hookee' + }; + + get '/on_import' => sub { + some_import(); # execute 'plugin_import' + } + + } + + my $app = App3->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + is( $counter, 0, 'the hook has not been executed' ); + + is( + $cb->( GET '/hooks_plugin' )->content, + 'hook for plugin', + '... route is rendered', + ); + + is( $counter, 1, '... and the hook has been executed exactly once' ); + + is( + $cb->( GET '/hook_returns_stuff' )->content, + '', + '... hook does not influence rendered content by return value', + ); + + # call the route that has an additional test + $cb->( GET '/hook_with_var' ); + + is ( + $cb->( GET '/on_import' )->content, + Dancer2->VERSION, + 'hooks added by on_plugin_import don\'t stop hooks being added later' + ); + }; +}; + +sub _normalize { + my ($json) = @_; + + my $data = decode_json($json); + foreach (keys %$data) { + $data->{$_} = $data->{$_} * 1 if ($data->{$_} =~ m/^\d+$/); + } + + return encode_json($data); +} + +done_testing; diff --git a/t/prepare_app.t b/t/prepare_app.t new file mode 100644 index 00000000..4b89e08c --- /dev/null +++ b/t/prepare_app.t @@ -0,0 +1,61 @@ +use strict; +use warnings; +use Plack::Test; +use HTTP::Request::Common; +use Test::More 'tests' => 2; + +{ + package Foo; + use Dancer2; + + prepare_app { + set 'app_1' => 'called 1'; + }; + + get '/' => sub {'OK'}; +} + +{ + package Bar; + use Dancer2 'appname' => 'Foo'; + + prepare_app { + set 'app_2' => 'called 2'; + }; + + get '/' => sub {'OK'}; +} + +subtest 'Foo' => sub { + my $app = Foo->to_app; + is( + Foo->config()->{'app_1'}, + 'called 1', + 'App 1 had prepare_app called', + ); + + my $test = Plack::Test->create($app); + my $res = $test->request( GET '/' )->content(); + is( + $res, + 'OK', + 'Correct content', + ); +}; + +subtest 'Bar' => sub { + my $app = Bar->to_app; + is( + Bar->config()->{'app_2'}, + 'called 2', + 'App 2 had prepare_app called', + ); + + my $test = Plack::Test->create($app); + my $res = $test->request( GET '/' )->content(); + is( + $res, + 'OK', + 'Correct content', + ); +}; diff --git a/t/psgi_app.t b/t/psgi_app.t new file mode 100644 index 00000000..0fd69a1c --- /dev/null +++ b/t/psgi_app.t @@ -0,0 +1,92 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 25; +use Plack::Test; +use HTTP::Request::Common; + +{ package App1; use Dancer2; get '/1' => sub {1}; } +{ package App2; use Dancer2; get '/2' => sub {2}; } +{ package App3; use Dancer2; get '/3' => sub {3}; } + +sub is_available { + my ( $cb, @apps ) = @_; + foreach my $app (@apps) { + is( $cb->( GET "/$app" )->content, $app, "App$app available" ); + } +} + +sub isnt_available { + my ( $cb, @apps ) = @_; + foreach my $app (@apps) { + is( + $cb->( GET "/$app" )->code, + 404, + "App$app is not available", + ); + } +} + +note 'All Apps'; { + my $app = Dancer2->psgi_app; + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + is_available( $cb, 1, 2, 3 ); + }; +} + +note 'Specific Apps by parameters'; { + my @apps = @{ Dancer2->runner->apps }[ 0, 2 ]; + is( scalar @apps, 2, 'Took two apps from the Runner' ); + my $app = Dancer2->psgi_app(\@apps); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + is_available( $cb, 1, 3 ); + isnt_available( $cb, 2 ); + }; +} + +note 'Specific Apps via App objects'; { + my $app = App2->psgi_app; + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + is_available( $cb, 2 ); + isnt_available( $cb, 1, 3 ); + }; +}; + +note 'Specific apps by App names'; { + my $app = Dancer2->psgi_app( [ 'App1', 'App3' ] ); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + isnt_available( $cb, 2 ); + is_available( $cb, 1, 3 ); + }; +} + +note 'Specific apps by App names with regular expression, v1'; { + my $app = Dancer2->psgi_app( [ qr/^App1$/, qr/^App3$/ ] ); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + isnt_available( $cb, 2 ); + is_available( $cb, 1, 3 ); + }; +} + +note 'Specific apps by App names with regular expression, v2'; { + my $app = Dancer2->psgi_app( [ qr/^App(2|3)$/ ] ); + isa_ok( $app, 'CODE', 'Got PSGI app' ); + test_psgi $app, sub { + my $cb = shift; + isnt_available( $cb, 1 ); + is_available( $cb, 2, 3 ); + }; +} + diff --git a/t/psgi_app_forward_and_pass.t b/t/psgi_app_forward_and_pass.t new file mode 100644 index 00000000..84cb3316 --- /dev/null +++ b/t/psgi_app_forward_and_pass.t @@ -0,0 +1,49 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use Test::More tests => 4; +use Plack::Test; +use HTTP::Request::Common; + +{ + package App1; + use Dancer2; + get '/' => sub {'App1'}; +} + +{ + package App2; + use Dancer2; + get '/pass' => sub { pass }; +} + +{ + package App3; + use Dancer2; + get '/pass' => sub {'App3'}; + get '/forward' => sub { forward '/' }; +} + +# pass from App2 to App3 +# forward from App3 to App1 +my $app = Dancer2->psgi_app; +isa_ok( $app, 'CODE' ); + +test_psgi $app, sub { + my $cb = shift; + + is( $cb->( GET '/' )->content, 'App1', 'Simple request' ); + + is( + $cb->( GET '/pass' )->content, + 'App3', + 'Passing from App to App works', + ); + + is( + $cb->( GET '/forward' )->content, + 'App1', + 'Forwarding from App to App works', + ); +}; diff --git a/t/public/file.txt b/t/public/file.txt new file mode 100644 index 00000000..71d75fca --- /dev/null +++ b/t/public/file.txt @@ -0,0 +1 @@ +this is a public file diff --git a/t/redirect.t b/t/redirect.t new file mode 100644 index 00000000..c6b796da --- /dev/null +++ b/t/redirect.t @@ -0,0 +1,244 @@ +use strict; +use warnings; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +subtest 'basic redirects' => sub { + { + package App1; + use Dancer2; + + get '/' => sub {'home'}; + get '/bounce' => sub { redirect '/' }; + get '/redirect' => sub { response_header 'X-Foo' => 'foo'; redirect '/'; }; + get '/redirect_querystring' => sub { redirect '/login?failed=1' }; + } + + my $app = App1->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + { + my $res = $cb->( GET '/' ); + + is( $res->code, 200, '[GET /] Correct code' ); + is( $res->content, 'home', '[GET /] Correct content' ); + + is( + $res->headers->content_type, + 'text/html', + '[GET /] Correct content-type', + ); + + is( + $cb->( GET '/bounce' )->code, + 302, + '[GET /bounce] Correct code', + ); + } + + { + my $res = $cb->( GET '/redirect' ); + + is( $res->code, 302, '[GET /redirect] Correct code' ); + + is( + $res->headers->header('Location'), + 'http://localhost/', + 'Correct Location header', + ); + + is( + $res->headers->header('X-Foo'), + 'foo', + 'Correct X-Foo header', + ); + } + + { + my $res = $cb->( GET '/redirect_querystring' ); + + is( $res->code, 302, '[GET /redirect_querystring] Correct code' ); + + is( + $res->headers->header('Location'), + 'http://localhost/login?failed=1', + 'Correct Location header', + ); + } + }; +}; + +# redirect absolute +subtest 'absolute and relative redirects' => sub { + { + package App2; + use Dancer2; + + get '/absolute_with_host' => + sub { redirect "http://foo.com/somewhere"; }; + get '/absolute' => sub { redirect "/absolute"; }; + get '/relative' => sub { redirect "somewhere/else"; }; + } + + my $app = App2->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + { + my $res = $cb->( GET '/absolute_with_host' ); + + is( + $res->headers->header('Location'), + 'http://foo.com/somewhere', + 'Correct Location header', + ); + } + + { + my $res = $cb->( GET '/absolute' ); + + is( + $res->headers->header('Location'), + 'http://localhost/absolute', + 'Correct Location header', + ); + } + + { + my $res = $cb->( GET '/relative' ); + + is( + $res->headers->header('Location'), + 'http://localhost/somewhere/else', + 'Correct Location header', + ); + } + }; +}; + +subtest 'redirect behind a proxy' => sub { + { + package App3; + use Dancer2; + prefix '/test2'; + set behind_proxy => 1; + get '/bounce' => sub { redirect '/test2' }; + } + + my $app = App3->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + { + is( + $cb->( + GET '/test2/bounce', + 'X-FORWARDED-HOST' => 'nice.host.name', + )->headers->header('Location'), + 'http://nice.host.name/test2', + 'behind a proxy, host() is read from X_FORWARDED_HOST', + ); + } + + { + is( + $cb->( + GET '/test2/bounce', + 'X-FORWARDED-HOST' => 'nice.host.name', + 'FORWARDED-PROTO' => 'https', + )->headers->header('Location'), + 'https://nice.host.name/test2', + '... and the scheme is read from HTTP_FORWARDED_PROTO', + ); + } + + { + is( + $cb->( + GET '/test2/bounce', + 'X-FORWARDED-HOST' => 'nice.host.name', + 'X-FORWARDED-PROTOCOL' => 'ftp', # stupid, but why not? + )->headers->header('Location'), + 'ftp://nice.host.name/test2', + '... or from X_FORWARDED_PROTOCOL', + ); + } + + { + is( + $cb->( + GET '/test2/bounce', + 'X-FORWARDED-HOST' => 'nice.host.name', + 'X-FORWARDED-PROTO' => 'https', + )->headers->header('Location'), + 'https://nice.host.name/test2', + '... or from X_FORWARDED_PROTO', + ); + } + }; +}; + +subtest 'redirect behind multiple proxies' => sub { + { + + package App4; + use Dancer2; + prefix '/test2'; + set behind_proxy => 1; + get '/bounce' => sub { redirect '/test2' }; + } + + my $app = App4->to_app; + ok( is_coderef($app), 'Got app' ); + + test_psgi $app, sub { + my $cb = shift; + + { + is( + $cb->( + GET '/test2/bounce', + 'X-FORWARDED-HOST' => "proxy1.example, proxy2.example", + )->headers->header('Location'), + 'http://proxy1.example/test2', + "behind multiple proxies, host() is read from X_FORWARDED_HOST", + ); + } + + { + is( + $cb->( + GET '/test2/bounce', + 'X-FORWARDED-HOST' => "proxy1.example, proxy2.example", + 'FORWARDED-PROTO' => 'https', + )->headers->header('Location'), + 'https://proxy1.example/test2', + '... and the scheme is read from HTTP_FORWARDED_PROTO', + ); + } + + { + is( + $cb->( + GET '/test2/bounce', + 'X-FORWARDED-HOST' => "proxy1.example, proxy2.example", + 'X-FORWARDED-PROTOCOL' => 'ftp', # stupid, but why not? + )->headers->header('Location'), + 'ftp://proxy1.example/test2', + '... or from X_FORWARDED_PROTOCOL', + ); + } + }; +}; + +done_testing; diff --git a/t/release-distmeta.t b/t/release-distmeta.t new file mode 100644 index 00000000..ff0d696d --- /dev/null +++ b/t/release-distmeta.t @@ -0,0 +1,14 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + print qq{1..0 # SKIP these tests are for release candidate testing\n}; + exit + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::MetaTests. + +use Test::CPAN::Meta; + +meta_yaml_ok(); diff --git a/t/request.t b/t/request.t new file mode 100644 index 00000000..4e087f98 --- /dev/null +++ b/t/request.t @@ -0,0 +1,273 @@ +use strict; +use warnings; +use Test::More; + +use Dancer2::Core::App; +use Dancer2::Core::Request; + +diag "If you want extra speed, install URL::Encode::XS" + if !$Dancer2::Core::Request::XS_URL_DECODE; +diag "If you want extra speed, install CGI::Deurl::XS" + if !$Dancer2::Core::Request::XS_PARSE_QUERY_STRING; + +sub run_test { + my $env = { + 'psgi.url_scheme' => 'http', + REQUEST_METHOD => 'GET', + SCRIPT_NAME => '/foo', + PATH_INFO => '/bar/baz', + REQUEST_URI => '/foo/bar/baz', + QUERY_STRING => 'foo=42&bar=12&bar=13&bar=14', + SERVER_NAME => 'localhost', + SERVER_PORT => 5000, + SERVER_PROTOCOL => 'HTTP/1.1', + REMOTE_ADDR => '127.0.0.1', + HTTP_X_FORWARDED_FOR => '127.0.0.2', + HTTP_X_FORWARDED_HOST => 'secure.frontend', + HTTP_X_FORWARDED_PROTOCOL => 'https', + REMOTE_HOST => 'localhost', + HTTP_USER_AGENT => 'Mozilla', + REMOTE_USER => 'sukria', + HTTP_COOKIE => 'cookie.a=foo=bar; cookie.b=1234abcd; no.value.cookie', + }; + + my $req = Dancer2::Core::Request->new( env => $env ); + + note "tests for accessors"; + + is $req->agent, 'Mozilla'; + is $req->user_agent, 'Mozilla'; + is $req->remote_address, '127.0.0.1'; + is $req->address, '127.0.0.1'; + is $req->forwarded_for_address, '127.0.0.2'; + is $req->remote_host, 'localhost'; + is $req->protocol, 'HTTP/1.1'; + is $req->port, 5000; + is $req->request_uri, '/foo/bar/baz'; + is $req->uri, '/foo/bar/baz'; + is $req->user, 'sukria'; + is $req->script_name, '/foo'; + is $req->scheme, 'http'; + is $req->referer, undef; + ok( !$req->secure ); + is $req->method, 'GET'; + is $req->request_method, 'GET'; + ok( $req->is_get ); + ok( !$req->is_post ); + ok( !$req->is_put ); + ok( !$req->is_delete ); + ok( !$req->is_patch ); + ok( !$req->is_head ); + + is $req->id, 1; + is $req->to_string, '[#1] GET /bar/baz'; + + note "tests params"; + is_deeply { $req->params }, { foo => 42, bar => [ 12, 13, 14 ] }; + + note "tests cookies"; + is( keys %{ $req->cookies }, 2, "multiple cookies extracted" ); + + my $forward = Dancer2::Core::App->new( request => $req ) + ->make_forward_to('/somewhere'); + is $forward->path_info, '/somewhere'; + is $forward->method, 'GET'; + note "tests for uri_for"; + is $req->base, 'http://localhost:5000/foo'; + is $req->uri_for( 'bar', { baz => 'baz' } ), + 'http://localhost:5000/foo/bar?baz=baz'; + + is $req->uri_for('/bar'), 'http://localhost:5000/foo/bar'; + is $req->uri_for( '/bar', undef, 1 ), + 'http://localhost:5000/foo/bar', + 'uri_for returns a URI (with $dont_escape)'; + + is $req->request_uri, '/foo/bar/baz'; + is $req->path_info, '/bar/baz'; + + { + local $env->{SCRIPT_NAME} = ''; + is $req->uri_for('/foo'), 'http://localhost:5000/foo'; + } + + { + local $env->{SERVER_NAME} = 0; + is $req->base, 'http://0:5000/foo'; + local $env->{HTTP_HOST} = 'oddhostname:5000'; + is $req->base, 'http://oddhostname:5000/foo'; + } + + note "testing behind proxy"; { + my $req = Dancer2::Core::Request->new( + env => $env, + is_behind_proxy => 1 + ); + is $req->secure, 1; + is $req->host, $env->{HTTP_X_FORWARDED_HOST}; + is $req->scheme, 'https'; + } + + note "testing behind proxy when optional headers are not set"; { + # local modifications to env: + local $env->{HTTP_HOST} = 'oddhostname:5000'; + delete local $env->{'HTTP_X_FORWARDED_FOR'}; + delete local $env->{'HTTP_X_FORWARDED_HOST'}; + delete local $env->{'HTTP_X_FORWARDED_PROTOCOL'}; + my $req = Dancer2::Core::Request->new( + env => $env, + is_behind_proxy => 1 + ); + is ! $req->secure, 1; + is $req->host, 'oddhostname:5000'; + is $req->scheme, 'http'; + } + + note "testing path and uri_base"; { + # Base env used for path and uri_base tests + my $base = { + 'psgi.url_scheme' => 'http', + REQUEST_METHOD => 'GET', + QUERY_STRING => '', + SERVER_NAME => 'localhost', + SERVER_PORT => 5000, + SERVER_PROTOCOL => 'HTTP/1.1', + }; + + # PATH_INFO not set + my $env = { + %$base, + SCRIPT_NAME => '/foo', + PATH_INFO => '', + REQUEST_URI => '/foo', + }; + my $req = Dancer2::Core::Request->new( env => $env ); + is( $req->path, '/', 'path corrent when empty PATH_INFO' ); + is( $req->uri_base, 'http://localhost:5000/foo', + 'uri_base correct when empty PATH_INFO' + ); + + # SCRIPT_NAME not set + $env = { + %$base, + SCRIPT_NAME => '', + PATH_INFO => '/foo', + REQUEST_URI => '/foo', + }; + $req = Dancer2::Core::Request->new( env => $env ); + is( $req->path, '/foo', 'path corrent when empty SCRIPT_NAME' ); + is( $req->uri_base, 'http://localhost:5000', + 'uri_base handles empty SCRIPT_NAME' + ); + + # Both SCRIPT_NAME and PATH_INFO set + # PSGI spec does not allow SCRIPT_NAME='/', PATH_INFO='/some/path' + $env = { + %$base, + SCRIPT_NAME => '/foo', + PATH_INFO => '/bar/baz/', + REQUEST_URI => '/foo/bar/baz/', + }; + $req = Dancer2::Core::Request->new( env => $env ); + is( $req->path, '/bar/baz/', + 'path corrent when both PATH_INFO and SCRIPT_NAME set' + ); + is( $req->uri_base, 'http://localhost:5000/foo', + 'uri_base correct when both PATH_INFO and SCRIPT_NAME set', + ); + + # Neither SCRIPT_NAME or PATH_INFO set + $env = { + %$base, + SCRIPT_NAME => '', + PATH_INFO => '', + REQUEST_URI => '/foo/', + }; + $req = Dancer2::Core::Request->new( env => $env ); + is( $req->path, '/', + 'path corrent when calculated from REQUEST_URI' + ); + is( $req->uri_base, 'http://localhost:5000', + 'uri_base correct when calculated from REQUEST_URI', + ); + } + + note "testing forward"; + $env = { + 'REQUEST_METHOD' => 'GET', + 'REQUEST_URI' => '/', + 'PATH_INFO' => '/', + 'QUERY_STRING' => 'foo=bar&number=42', + }; + + $req = Dancer2::Core::Request->new( env => $env ); + is $req->path, '/', 'path is /'; + is $req->method, 'GET', 'method is get'; + is_deeply scalar( $req->params ), { foo => 'bar', number => 42 }, + 'params are parsed'; + + $req = Dancer2::Core::App->new( request => $req ) + ->make_forward_to('/new/path'); + is $req->path, '/new/path', 'path is changed'; + is $req->method, 'GET', 'method is unchanged'; + is_deeply scalar( $req->params ), { foo => 'bar', number => 42 }, + 'params are not touched'; + + $req = Dancer2::Core::App->new( request => $req ) + ->make_forward_to( + '/new/path', + undef, + { method => 'POST' }, + ); + + is $req->path, '/new/path', 'path is changed'; + + is $req->method, 'POST', 'method is changed'; + is_deeply scalar( $req->params ), { foo => 'bar', number => 42 }, + 'params are not touched'; + + note "testing unicode params"; + $env = { + 'REQUEST_METHOD' => 'GET', + 'REQUEST_URI' => '/', + 'PATH_INFO' => '/', + 'QUERY_STRING' => "M%C3%BCller=L%C3%BCdenscheid", + }; + $req = Dancer2::Core::Request->new( env => $env ); + is_deeply scalar( $req->params ), { "M\N{U+00FC}ller", "L\N{U+00FC}denscheid" }, + 'multi byte unicode chars work in param keys and values'; + { + note "testing private _decode not to mangle hash"; + my @warnings; + local $SIG{__WARN__} = sub { + push @warnings, @_; + }; + + my $h = { zzz => undef, }; + for ( 'aaa' .. 'fff' ) { + $h->{$_} = $_; + } + + my $i = Dancer2::Core::Request::_decode($h); + is_deeply( $i, $h, 'hash not mangled' ); + ok( !@warnings, 'no warnings were issued' ); + } +} + +note "Run test with XS_URL_DECODE" if $Dancer2::Core::Request::XS_URL_DECODE; +note "Run test with XS_PARSE_QUERY_STRING" + if $Dancer2::Core::Request::XS_PARSE_QUERY_STRING; +run_test(); +if ($Dancer2::Core::Request::XS_PARSE_QUERY_STRING) { + note "Run test without XS_PARSE_QUERY_STRING"; + $Dancer2::Core::Request::XS_PARSE_QUERY_STRING = 0; + $Dancer2::Core::Request::_id = 0; + run_test(); +} +if ($Dancer2::Core::Request::XS_URL_DECODE) { + note "Run test without XS_URL_DECODE"; + $Dancer2::Core::Request::XS_URL_DECODE = 0; + $Dancer2::Core::Request::_id = 0; + run_test(); +} + +done_testing; diff --git a/t/request_make_forward_to.t b/t/request_make_forward_to.t new file mode 100644 index 00000000..ac06b379 --- /dev/null +++ b/t/request_make_forward_to.t @@ -0,0 +1,38 @@ +use strict; +use warnings; +use Test::More tests=>1; +use Plack::Test; +use HTTP::Request::Common; +use JSON::MaybeXS; + +{ + + package ContentLengthTestApp; + use Dancer2; + set serializer => 'JSON'; + + post '/foo' => sub { + forward('/not_authorized'); + }; + + any '/not_authorized' => sub { + status 401; + { access => 'denied' }; + }; +} + +{ + my $url = 'http://localhost'; + my $test = Plack::Test->create( ContentLengthTestApp->to_app ); + + my $response = $test->request( + POST( + '/foo', + Content => + encode_json( { target => [ 'foo', 'bar' ] } ), + ) + ); + + is( $response->code, 401, 'Access denied to unauthorized merge' ); + +} diff --git a/t/request_upload.t b/t/request_upload.t new file mode 100644 index 00000000..9c49ba43 --- /dev/null +++ b/t/request_upload.t @@ -0,0 +1,196 @@ +use strict; +use warnings FATAL => 'all'; +use Test::More; +use Test::Fatal; + +use Dancer2::Core::Request; + +use Carp; +use File::Temp 0.22; +use File::Basename qw/dirname basename/; +use File::Spec; +use Encode qw(encode_utf8); + +diag "If you want extra speed, install URL::Encode::XS" + if !$Dancer2::Core::Request::XS_URL_DECODE; +diag "If you want extra speed, install CGI::Deurl::XS" + if !$Dancer2::Core::Request::XS_PARSE_QUERY_STRING; + +sub test_path { + my ( $file, $dir ) = @_; + is dirname($file), $dir, "dir of $file is $dir"; +} + +sub run_test { + my $filename = "some_\x{1A9}_file.txt"; + + my $content = qq{------BOUNDARY +Content-Disposition: form-data; name="test_upload_file"; filename="$filename" +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; + $content = encode_utf8($content); + + + do { + open my $in, '<', \$content; + my $req = Dancer2::Core::Request->new( + env => { + '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, 'non-existent upload as array is empty'; + my $undef = $req->upload('undef'); + is $undef, undef, '... and non-existent upload as scalar is undef'; + + my @uploads = $req->upload('test_upload_file'); + like $uploads[0]->content, qr|^SHOGUN|, + "content for first upload is ok, via 'upload'"; + like $uploads[1]->content, qr|^SHOGUN|, + "... content for second as well"; + is $req->uploads->{'test_upload_file4'}[0]->content, 'SHOGUN4', + "... content for other also good"; + + note "headers and decoded filename"; + my $encoded_filename = encode_utf8($filename); + is_deeply $uploads[0]->headers, + { 'Content-Disposition' => + qq[form-data; name="test_upload_file"; filename="$encoded_filename"], + 'Content-Type' => 'text/plain', + }; + is $uploads[0]->filename, $filename; + + note "type"; + is $uploads[0]->type, 'text/plain'; + + my $test_upload_file3 = $req->upload('test_upload_file3'); + is $test_upload_file3->content, 'SHOGUN3', + "content for upload #3 as a scalar is good, via req->upload"; + + my @test_upload_file6 = $req->upload('test_upload_file6'); + is $test_upload_file6[0]->content, 'SHOGUN6', + "content for upload #6 is good"; + + is $test_upload_file6[0]->content(':raw'), 'SHOGUN6'; + + my $upload = $req->upload('test_upload_file6'); + isa_ok $upload, 'Dancer2::Core::Request::Upload'; + is $upload->filename, 'yappo6.txt', 'filename is ok'; + ok $upload->file_handle, 'file handle is defined'; + is $req->params->{'test_upload_file6'}, 'yappo6.txt', + "filename is accessible via params"; + + # copy_to, link_to + my $dest_dir = File::Temp::tempdir( CLEANUP => 1, TMPDIR => 1 ); + my $dest_file = File::Spec->catfile( $dest_dir, $upload->basename ); + $upload->copy_to($dest_file); + ok( ( -f $dest_file ), "file '$dest_file' has been copied" ); + + my $dest_file_link = File::Spec->catfile( $dest_dir, "hardlink" ); + $upload->link_to($dest_file_link); + ok( ( -f $dest_file_link ), + "hardlink '$dest_file_link' has been created" + ); + + # make sure cleanup is performed when the HTTP::Body object is purged + my $file = $upload->tempname; + ok( ( -f $file ), 'temp file exists while request object lives' ); + undef $req; + SKIP: { + skip + "Win32 can't remove file/link while open due to deadlock", + 1 + if ( $^O eq 'MSWin32' ); + ok( ( !-f $file ), + 'temp file is removed when request object dies' + ); + } + + + note "testing failing open for tempfile"; + { + + # mocking open_file to make it fail + my $upload_file_coderef; + { + no strict 'refs'; + $upload_file_coderef = + *{"Dancer2::Core::Request::Upload::open_file"}{CODE}; + no warnings 'redefine'; + *{"Dancer2::Core::Request::Upload::open_file"} = sub { + croak "Can't open mocked-tempfile using mode '<'"; + }; + } + $upload->{_fh} = undef; + like( + exception { $upload->file_handle }, + qr{Can't open.* using mode '<'}, + ); + + # unmock open_file + { + no strict 'refs'; + no warnings 'redefine'; + *{"Dancer2::Core::Request::Upload::open_file"} = + $upload_file_coderef; + } + } + + unlink($file) if ( $^O eq 'MSWin32' ); + }; +} + +note "Run test with XS_URL_DECODE" if $Dancer2::Core::Request::XS_URL_DECODE; +note "Run test with XS_PARSE_QUERY_STRING" + if $Dancer2::Core::Request::XS_PARSE_QUERY_STRING; +run_test(); +if ($Dancer2::Core::Request::XS_PARSE_QUERY_STRING) { + note "Run test without XS_PARSE_QUERY_STRING"; + $Dancer2::Core::Request::XS_PARSE_QUERY_STRING = 0; + $Dancer2::Core::Request::_count = 0; + run_test(); +} +if ($Dancer2::Core::Request::XS_URL_DECODE) { + note "Run test without XS_URL_DECODE"; + $Dancer2::Core::Request::XS_URL_DECODE = 0; + $Dancer2::Core::Request::_count = 0; + run_test(); +} + +done_testing; diff --git a/t/response.t b/t/response.t new file mode 100644 index 00000000..6e5dafcd --- /dev/null +++ b/t/response.t @@ -0,0 +1,65 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Dancer2; +use Dancer2::Core::Response; + +my $r = Dancer2::Core::Response->new( content => "hello" ); +is $r->status, 200; +is $r->content, 'hello'; + +note "content_type"; +$r = Dancer2::Core::Response->new( + headers => [ 'Content-Type' => 'text/html' ], + content => 'foo', +); + +is_deeply $r->to_psgi, + [ 200, + [ Server => "Perl Dancer2 " . Dancer2->VERSION, + 'Content-Length' => 3, + 'Content-Type' => 'text/html', + ], + ['foo'] + ]; + +isa_ok $r->headers, 'HTTP::Headers'; +is $r->content_type, 'text/html'; + +$r->content_type('text/plain'); +is $r->content_type, 'text/plain'; + +ok( !$r->is_forwarded ); +$r->forward('http://perldancer.org'); +ok( $r->is_forwarded ); + +is $r->header('X-Foo'), undef; + +$r->header( 'X-Foo' => 42 ); +is $r->header('X-Foo'), 42; + +$r->header( 'X-Foo' => 432 ); +is $r->header('X-Foo'), 432; + +$r->push_header( 'X-Foo' => 777 ); +is $r->header('X-Foo'), '432, 777'; + +$r->header( 'X-Bar' => 234 ); +is $r->header('X-Bar'), '234'; + +is scalar( @{ $r->headers_to_array } ), 12; + +# stringify HTTP status +$r = Dancer2::Core::Response->new( content => "foo", status => "Not Found" ); +is $r->status, 404; + +$r = + Dancer2::Core::Response->new( content => "foo", status => "not_modified" ); +is $r->status, 304; + +# test setting content as "0" +$r = Dancer2::Core::Response->new( content => "foo" ); +$r->content("0"); +is $r->content, "0"; + +done_testing; diff --git a/t/roles/hook.t b/t/roles/hook.t new file mode 100644 index 00000000..eabdabef --- /dev/null +++ b/t/roles/hook.t @@ -0,0 +1,67 @@ +use strict; +use warnings; +use Test::More tests => 8; +use Test::Fatal; + +use Dancer2::Core::Hook; + +my $h = + Dancer2::Core::Hook->new( name => 'before_template', code => sub {'BT'} ); +is $h->name, 'before_template_render'; +is $h->code->(), 'BT'; + +{ + + package Foo; + use Moo; + with 'Dancer2::Core::Role::Hookable'; + sub hook_aliases { +{} } + sub supported_hooks {'foobar'} +} + +my $f = Foo->new; + +like( + exception { $f->execute_hook() }, + qr{execute_hook needs a hook name}, + 'execute_hook needs a hook name', +); + +my $count = 0; +my $some_hook = Dancer2::Core::Hook->new( + name => 'foobar', + code => sub { + $count++; + } +); + +ok( !exception { $f->add_hook($some_hook) }, + 'Supported hook can be installed', +); + +like( + exception { + $f->add_hook( + Dancer2::Core::Hook->new( + name => 'unknown_hook', + code => sub { $count++; } + ) + ); + }, + qr{Unsupported hook 'unknown_hook'}, + 'Unsupported hook cannot be installed', +); + +$f->execute_hook('foobar'); +is $count, 1; + +like( + exception { $f->replace_hook( 'doesnotexist', [] ) }, + qr{Hook 'doesnotexist' must be installed first}, + 'Nonexistent hook fails', +); + +my $new_hooks = [ sub { $count-- }, sub { $count-- }, sub { $count-- } ]; +$f->replace_hook( 'foobar', $new_hooks ); +$f->execute_hook('foobar'); +is $count, -2, 'replaced hooks were installed and executed'; diff --git a/t/route-pod-coverage/route-pod-coverage.t b/t/route-pod-coverage/route-pod-coverage.t new file mode 100644 index 00000000..a2e91a62 --- /dev/null +++ b/t/route-pod-coverage/route-pod-coverage.t @@ -0,0 +1,27 @@ +use strict; +use warnings; + +use Test::More; + +use lib '.'; +use t::lib::TestPod; +use Dancer2::Test apps => ['t::lib::TestPod']; + +is_pod_covered 'is pod covered'; + +my $pod_structure = { + 't::lib::TestPod' => { + 'has_pod' => 1, + 'routes' => [ + "post /in_testpod/*", + "post /me:id", + "get /in_testpod", + "get /hello", + "get /me:id" + ] + } +}; + +is_deeply( route_pod_coverage, $pod_structure, 'my pod looks like expected' ); + +done_testing; diff --git a/t/scope_problems/config.yml b/t/scope_problems/config.yml new file mode 100644 index 00000000..a512f360 --- /dev/null +++ b/t/scope_problems/config.yml @@ -0,0 +1 @@ +logger: "Note" diff --git a/t/scope_problems/dispatcher_internal_request.t b/t/scope_problems/dispatcher_internal_request.t new file mode 100644 index 00000000..51e37a56 --- /dev/null +++ b/t/scope_problems/dispatcher_internal_request.t @@ -0,0 +1,32 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common qw/GET/; +use Dancer2; + +{ + package Test::App; + use Dancer2; + + use Data::Dumper; + set behind_proxy => 1; + set views => 't/views'; + + # The 'die' was causing the Runners' internal_request + # object to not get cleaned up when returning from dispatch. + hook before => sub { die "Nope, Nope, Nope" }; + + get '/' => sub { + send_error "Yes yes YES!"; + }; +} + +my $test = Plack::Test->create(Dancer2->psgi_app); + +my $res = $test->request(GET '/'); +is( Dancer2->runner->{'internal_request'}, undef, + "Runner internal request cleaned up" ); + +done_testing; + diff --git a/t/scope_problems/keywords_before_template_hook.t b/t/scope_problems/keywords_before_template_hook.t new file mode 100644 index 00000000..166b36d7 --- /dev/null +++ b/t/scope_problems/keywords_before_template_hook.t @@ -0,0 +1,43 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common qw/GET/; +use File::Basename 'dirname'; +use File::Spec; + +my $views; +BEGIN { + $views = File::Spec->rel2abs( File::Spec->catfile( dirname(__FILE__), 'views' ) ); +} + +eval { require Template; Template->import(); 1 } + or plan skip_all => 'Template::Toolkit probably missing.'; + +{ + package Test::App; + use Dancer2; + + set views => $views; + set logger => 'Note'; + set template => 'template_toolkit'; + + hook before_template_render => sub { + my $tokens = shift; + var some_var => 21; # var can only be used in a route handler.. + }; + + get '/' => sub { + die "Yes yes YES!"; + }; +} + +my $test = Plack::Test->create(Test::App->to_app); + +my $res = $test->request(GET '/'); +is($res->code, 500, "Got 500 response"); +like( $res->content, qr/This is a dummy error template/, + "with the template content" ); + +done_testing; + diff --git a/t/scope_problems/session_is_cleared.t b/t/scope_problems/session_is_cleared.t new file mode 100644 index 00000000..2bfd687a --- /dev/null +++ b/t/scope_problems/session_is_cleared.t @@ -0,0 +1,65 @@ +#!/usr/bin/env perl + +## This test will first cause a (legitimate) error in a +## before_template_render hook +## Then it will fetch an unrelated route that should return normally. +## However, this route is now using the wrong with_return block. +## This is because the first route, errors in rendering the *error* page. +## This cause the block to die, and with_return is never unset. +## This test uses two template files + +package MyTestApp; +use Dancer2; + +hook before_template_render => sub { + my $path = request->path; + if ( $path =~ m!route_with_renderer_error! ) { + die session->id; + } +}; + +get '/route_with_renderer_error' => sub { + ## This route first gets called, then template fires the above hook. + ## This hook errors, causing Dancer2::Core::App, to throw an error + ## which *also* fires the hook, crashing the server. + session->write('bob' => "I SHOULD NOT BE IN THE NEXT SESSION"); + my $tt = session->id; + template \"$tt"; +}; + +get '/normal_route' => sub { + ## This should issue normally + if ( !session('bob') ) { + session('bob' => "test" . rand()); + } + return session('bob'); +}; + +package main; +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common qw/GET/; +use Dancer2; + +my $test = Plack::Test->create(Dancer2->psgi_app); + +## This route works fine +## Just a sanity check +my $res1 = $test->request(GET '/normal_route'); +ok($res1->is_success, '/normal_route does not error'); + +## This route should die and cause a broken state +my $res2 = $test->request(GET '/route_with_renderer_error'); +ok(! $res2->is_success, '/route_with_renderer_error errors errors'); + +## This route will now have the same session as the previous route. +## Despite not having any cookies... +my $res3 = $test->request(GET '/normal_route'); +ok($res3->is_success, '/normal_route does not error'); +my $session_value = $res3->decoded_content; +isnt($session_value, "I SHOULD NOT BE IN THE NEXT SESSION", + '3rd route does not have session value from second route'); + +done_testing(); diff --git a/t/scope_problems/views/500.tt b/t/scope_problems/views/500.tt new file mode 100644 index 00000000..e16a9711 --- /dev/null +++ b/t/scope_problems/views/500.tt @@ -0,0 +1 @@ +This is a dummy error template diff --git a/t/scope_problems/with_return_dies.t b/t/scope_problems/with_return_dies.t new file mode 100644 index 00000000..2f6397f3 --- /dev/null +++ b/t/scope_problems/with_return_dies.t @@ -0,0 +1,72 @@ +#!/usr/bin/env perl + +## This test will first cause a (legitimate) error in a +## before_template_render hook +## Then it will fetch an unrelated route that should return normally. +## However, this route is now using the wrong with_return block. +## This is because the first route, errors in rendering the *error* page. +## This cause the block to die, and with_return is never unset. +## This test uses two template files + +package MyTestApp; +use Dancer2; +use Scalar::Util qw/refaddr/; + +hook before_template_render => sub { + my $path = request->path; + my $refadd = refaddr(app->with_return); + if ( $path =~ m!route_with_renderer_error! ) { + die $refadd; + } +}; + +get '/route_with_renderer_error' => sub { + ## This route first gets called, then template fires the above hook. + ## This hook errors, causing Dancer2::Core::App, to throw an error + ## which *also* fires the hook, crashing the server. + my $addr = refaddr(app->with_return); + template \$addr; +}; + +get '/normal_route' => sub { + ## This should issue normally + # my $addr = refaddr(app->with_return); + # template \$addr; + return refaddr(app->with_return); +}; + +package main; +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common qw/GET/; +use Dancer2; + +my $test = Plack::Test->create(Dancer2->psgi_app); + +## This route works fine +my $res1 = $test->request(GET '/normal_route'); +ok($res1->is_success, '/normal_route does not error'); +my $refaddr1 = $res1->decoded_content; + +## This route should die +my $res2 = $test->request(GET '/route_with_renderer_error'); +ok(! $res2->is_success, '/route_with_renderer_error errors errors'); +my ($refaddr2) = $res2->decoded_content =~ /Hook error: (\d+)/; + +## The first route now errors +## I can't seem to force with_return to fail in this test, even though I have +## it failing in production. +## So instead I'll check the refaddr of the with_return +## If refaddr of with_return is the same between route2 and route3, then this +## demonstrates that with_return has not been cleared between the two routes +## And that /normal_route is now using the wrong with_return. +## Possibly the old with_return hasn't been cleaned up? not sure. +my $res3 = $test->request(GET '/normal_route'); +ok($res3->is_success, '/normal_route does not error'); +my $refaddr3 = $res3->decoded_content; +isnt($refaddr1, $refaddr3, 'The 3rd request has a different with_return from the first run'); +isnt($refaddr2, $refaddr3, 'The 3rd request has a different with_return from the second run'); + +done_testing(); diff --git a/t/serializer.t b/t/serializer.t new file mode 100644 index 00000000..be76fc85 --- /dev/null +++ b/t/serializer.t @@ -0,0 +1,42 @@ +use strict; +use warnings; + +use Test::More tests => 5; +use Dancer2::Serializer::Dumper; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + package MyApp; + use Dancer2; + set serializer => 'JSON'; + get '/json' => sub { +{ bar => 'baz' } }; +} + +my $app = MyApp->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + { + # Response with implicit call to the serializer + my $res = $cb->( GET '/json' ); + is( $res->code, 200, '[/json] Correct status' ); + is( $res->content, '{"bar":"baz"}', '[/json] Correct content' ); + is( + $res->headers->content_type, + 'application/json', + '[/json] Correct content-type headers', + ); + } +}; + +my $serializer = Dancer2::Serializer::Dumper->new(); + +is( + $serializer->content_type, + 'text/x-data-dumper', + 'content-type is set correctly', +); diff --git a/t/serializer_json.t b/t/serializer_json.t new file mode 100644 index 00000000..c11e2bb1 --- /dev/null +++ b/t/serializer_json.t @@ -0,0 +1,75 @@ +use strict; +use warnings; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use JSON::MaybeXS; + +use Dancer2::Serializer::JSON; + +# config +{ + package MyApp; + + use Dancer2; + our $entity; + + set engines => { + serializer => { + JSON => { + pretty => 1, + } + } + }; + set serializer => 'JSON'; + + get '/serialize' => sub { + return $entity; + }; +} + +my @tests = ( + { entity => { a => 1, b => 2, }, + options => { pretty => 1 }, + name => "basic hash", + }, + { entity => + { c => [ { d => 3, e => { f => 4, g => 'word', } } ], h => 6 }, + options => { pretty => 1 }, + name => "nested", + }, + { entity => { data => "\x{2620}" x 10 }, + options => { pretty => 1, utf8 => 1 }, + name => "utf8", + } +); + +my $app = MyApp->to_app; + +for my $test (@tests) { + my $expected = JSON::MaybeXS->new($test->{options})->encode($test->{entity}); + + # Helpers pass options + my $actual = + Dancer2::Serializer::JSON::to_json( $test->{entity}, $test->{options} ); + is( $actual, $expected, "to_json: $test->{name}" ); + + # Options from config + my $serializer = Dancer2::Serializer::JSON->new(config => $test->{options}); + my $output = $serializer->serialize( $test->{entity} ); + is( $output, $expected, "serialize: $test->{name}" ); + + $MyApp::entity = $test->{entity}; + test_psgi $app, sub { + my $cb = shift; + + my $res = $cb->( GET '/serialize' ); + is($res->content, $expected, + "serialized content in response: $test->{name}"); + }; + +} + + +done_testing(); diff --git a/t/serializer_mutable.t b/t/serializer_mutable.t new file mode 100644 index 00000000..89c19139 --- /dev/null +++ b/t/serializer_mutable.t @@ -0,0 +1,117 @@ +use strict; +use warnings; + +use Test::More tests => 5 +; +use Dancer2::Serializer::Mutable; +use Plack::Test; +use HTTP::Request::Common; +use Encode; +use JSON::MaybeXS; +use YAML; +use Ref::Util qw<is_coderef>; + +{ + package MyApp; + use Dancer2; + use Ref::Util qw<is_hashref>; + + set serializer => 'Mutable'; + + get '/serialize' => sub { +{ bar => 'baz' } }; + post '/deserialize' => sub { + return request->data && + is_hashref( request->data ) && + request->data->{bar} ? { bar => request->data->{bar} } : { ret => '?' }; + }; +} + +my $test = Plack::Test->create( MyApp->to_app ); + +subtest "serializer returns to default state" => sub { + + my $res = $test->request( GET '/serialize' ); + is( + $res->headers->content_type, + 'application/json', + "Default content-type header", + ); + + $res = $test->request( GET '/serialize', 'Accept' => 'text/x-data-dumper' ); + is( + $res->headers->content_type, + 'text/x-data-dumper', + "Correct content-type header", + ); + $res = $test->request( GET '/serialize' ); + is( + $res->headers->content_type, + 'application/json', + "Correct default content-type header after a request that used another", + ); +}; + + + +# Configure test content-type cases +my $d = { + yaml => { + types => [ qw(text/x-yaml text/html) ], + value => encode('UTF-8', YAML::Dump({ bar => 'baz' })), + last_val => "---bar:baz", + }, + dumper => { + types => [ qw(text/x-data-dumper) ], + value => Data::Dumper::Dumper({ bar => 'baz' }), + last_val => "\$VAR1={'bar'=>'baz'};", + }, + json => { + types => [ qw(text/x-json application/json) ], + value => JSON::MaybeXS::encode_json({ bar => 'baz' }), + last_val => '{"bar":"baz"}', + }, + default => { + types => [ '*/*', '' ], + value => JSON::MaybeXS::encode_json({ bar => 'baz' }), + last_val => '{"bar":"baz"}', + return_content_type => 'application/json', + }, +}; + +for my $format (keys %$d) { + + subtest "Format: $format" => sub { + my $s = $d->{$format}; + + # Response with implicit call to the serializer + for my $content_type ( @{ $s->{types} } ) { + + for my $ct (qw/Content-Type Accept/) { + + # Test getting the value serialized in the correct format + my $res = $test->request( GET '/serialize', $ct => $content_type ); + + is( $res->code, 200, "[/$format] Correct status" ); + is( $res->content, $s->{value}, "[/$format] Correct content" ); + is( + $res->headers->content_type, + $s->{return_content_type} || $content_type, + "[/$format] Correct content-type headers", + ); + } + + # Test sending the value serialized in the correct format + # needs to be de-serialized and returned + my $req = $test->request( POST '/deserialize', + 'Content-Type' => $content_type, + content => $s->{value} ); + + my $content = $req->content; + $content =~ s/\s//g; + is( $req->code, 200, "[/$format] Deserialize: correct status" ); + is( $content, $s->{last_val}, "[/$format] Deserialize: correct content" ); + + } #/ for my $content_type + }; #/ subtest + +} #/ for my $format diff --git a/t/serializer_mutable_custom.t b/t/serializer_mutable_custom.t new file mode 100644 index 00000000..ff37ba08 --- /dev/null +++ b/t/serializer_mutable_custom.t @@ -0,0 +1,126 @@ +=pod + +Same as t/serializer_mutable.t, but exercise the configurable +mappings + +=cut + +use strict; +use warnings; + +use Test::More tests => 5; +use Dancer2::Serializer::Mutable; +use Plack::Test; +use HTTP::Request::Common; +use Encode; +use JSON::MaybeXS; +use YAML; +use Ref::Util qw<is_coderef>; + +{ + package Dancer2::Serializer::Other; + + use Moo; + with 'Dancer2::Core::Role::Serializer'; + + has '+content_type' => ( default => 'text/other' ); + + sub serialize { '{thing}' } + sub deserialize { '{thing}' } + +} + +{ + package MyApp; + use Dancer2; + + BEGIN { + setting engines => { serializer => { Mutable => { mapping => { + 'text/x-yaml' => 'YAML', + 'text/x-data-dumper' => 'Dumper', + 'text/x-json' => 'JSON', + 'application/json' => 'JSON', + 'text/other' => 'Other', + } } } }; + } + + use Ref::Util qw<is_hashref>; + + set serializer => 'Mutable'; + + get '/serialize' => sub { +{ bar => 'baz' } }; + post '/deserialize' => sub { + return request->data && + is_hashref( request->data ) && + request->data->{bar} ? { bar => request->data->{bar} } : { ret => '?' }; + }; +} + +my $app = MyApp->to_app; +ok is_coderef($app), 'Got app'; + +test_psgi $app, sub { + my $cb = shift; + + # Configure all test cases + my $d = { + yaml => { + types => [ qw(text/x-yaml) ], + value => encode('UTF-8', YAML::Dump({ bar => 'baz' })), + last_val => "---bar:baz", + }, + other => { + types => [ qw(text/other) ], + value => '{thing}', + last_val => "{thing}", + }, + dumper => { + types => [ qw(text/x-data-dumper) ], + value => Data::Dumper::Dumper({ bar => 'baz' }), + last_val => "\$VAR1={'bar'=>'baz'};", + }, + json => { + types => [ qw(text/x-json application/json) ], + value => JSON::MaybeXS::encode_json({ bar => 'baz' }), + last_val => '{"bar":"baz"}', + }, + }; + + for my $format (keys %$d) { + subtest "Format: $format" => sub { + + my $s = $d->{$format}; + + # Response with implicit call to the serializer + for my $content_type ( @{ $s->{types} } ) { + subtest $content_type => sub { + for my $ct (qw/Content-Type Accept/) { + + # Test getting the value serialized in the correct format + my $res = $cb->( GET '/serialize', $ct => $content_type ); + + is( $res->code, 200, "status" ); + is( $res->content, $s->{value}, "content" ); + is( + $res->headers->content_type, + $content_type, + "content-type headers", + ); + } + + # Test sending the value serialized in the correct format + # needs to be de-serialized and returned + my $req = $cb->( POST '/deserialize', + 'Content-Type' => $content_type, + content => $s->{value} ); + + my $content = $req->content; + $content =~ s/\s//g; + is( $req->code, 200, "status" ); + is( $content, $s->{last_val}, "content" ); + } + } + } + } + +} diff --git a/t/session_bad_client_cookie.t b/t/session_bad_client_cookie.t new file mode 100644 index 00000000..7d223260 --- /dev/null +++ b/t/session_bad_client_cookie.t @@ -0,0 +1,119 @@ +use strict; +use warnings; +use Test::More; +use File::Spec; +use Plack::Test; +use HTTP::Request::Common; +use HTTP::Cookies; + +{ + package + Dancer2::Session::SimpleHexId; + use Moo; + extends 'Dancer2::Session::Simple'; + + # Subclass that only generates and accepts 8 character hex session id's + + our $valid_session_ids = 0; + + sub generate_id { + return join "", map { sprintf("%x", rand 16) } 1..8 + } + + sub validate_id { + my $ok = ( $_[1] =~ m/^[0-9a-f]{8}$/ ); + $valid_session_ids++ if $ok; # this should never increment in these tests + return $ok; + } +} + +{ + + package App; + use Dancer2; + + set engines => { + session => { + Simple => {cookie_name => 'dancer2.test'}, + SimpleHexId => {cookie_name => 'dancer2.test'}, + YAML => {cookie_name => 'dancer2.test'} + } + }; + + set session => 'Simple'; + set show_errors => 1; + + get '/set_session/*' => sub { + my ($name) = splat; + session name => $name; + }; +} + +my $url = 'http://localhost'; +my $test = Plack::Test->create(App->to_app); +my $app = Dancer2->runner->apps->[0]; + +my $bad_session_id = 'abcdefghijklmnopqrstuvwxyz123456'; + +for my $engine (qw(YAML Simple SimpleHexId)) { + + # clear current session engine, and rebuild for the test + # This is *really* messy, playing in object hashrefs.. + delete $app->{session_engine}; + $app->config->{session} = $engine; + my $session_engine = $app->session_engine; # trigger a build + + if ($session_engine->can('session_dir')) { + # make sure our test file does not exist + my $bad_session_file = + File::Spec->catfile($session_engine->session_dir, + $bad_session_id . $session_engine->_suffix); + unlink $bad_session_file; + } + + # run the tests for this engine + + my $jar = HTTP::Cookies->new; + + my @cookie; + + subtest "[$engine] set_session and extract cookie" => sub { + my $res = $test->request(GET "$url/set_session/larry"); + ok($res->is_success, "set_session"); + + $jar->extract_cookies($res); + ok($jar->as_string, 'Cookie set'); + + $jar->scan(sub { @cookie = @_ }); + }; + + subtest "[$engine] set_session with bad cookie value" => sub { + + # set session cookie value to something bad + $cookie[2] = $bad_session_id; + ok($jar->set_cookie(@cookie), "Set bad cookie value"); + + my $req = GET "$url/set_session/larry"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok $res->is_success, "/read_session"; + + $jar->clear; + ok(!$jar->as_string, 'Jar cleared'); + + $jar->extract_cookies($res); + ok($jar->as_string, 'session cookie set again'); + + my $sid; + $jar->scan(sub { $sid = $_[2] }); + isnt $sid, 'abcdefghijklmnopqrstuvwxyz123456', + "Session ID has been reset"; + }; +} + +subtest "[SimpleHexId] valid session id count" => sub { + is $Dancer2::Session::SimpleHexId::valid_session_ids, 0, + "No valid session keys passed during test" +}; + +done_testing; diff --git a/t/session_config.t b/t/session_config.t new file mode 100644 index 00000000..8e99c9bd --- /dev/null +++ b/t/session_config.t @@ -0,0 +1,86 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Cookies; +use HTTP::Request::Common; + +{ + package App; + use Dancer2; + + setting( + engines => { + session => { + Simple => { + cookie_name => 'dancer.sid', + cookie_path => '/foo', + cookie_duration => '1 hour', + is_http_only => 0, # will not show up in cookie + }, + }, + } + ); + + setting( session => 'Simple' ); + + get '/has_session' => sub { + return app->has_session; + }; + + get '/foo/set_session/*' => sub { + my ($name) = splat; + session name => $name; + }; + + get '/foo/read_session' => sub { + my $name = session('name') || ''; + "name='$name'"; + }; + + get '/foo/destroy_session' => sub { + my $name = session('name') || ''; + app->destroy_session; + return "destroyed='$name'"; + }; +} + +my $test = Plack::Test->create( App->to_app ); +my $url = 'http://localhost'; + +my $jar = HTTP::Cookies->new; + +subtest 'Set session' => sub { + my $res = $test->request( GET "$url/foo/set_session/larry" ); + ok( $res->is_success, '/foo/set_session/larry' ); + + $jar->extract_cookies($res); + ok( $jar->as_string, 'session cookie set' ); + + my ( $expires, $domain, $path, $opts ); + my $cookie = $jar->scan( sub { + ( $expires, $domain, $path, $opts ) = @_[ 8, 4, 3 ]; + } ); + + my $httponly = $opts->{'HttpOnly'}; + + ok $expires - time > 3540, + "cookie expiration is in future"; + + is $domain, 'localhost.local', "cookie domain set"; + is $path, '/foo', "cookie path set"; + is $httponly, undef, "cookie has not set HttpOnly"; + + # read value back +}; + +subtest 'Read session' => sub { + my $req = GET "$url/foo/read_session"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok $res->is_success, "/foo/read_session"; + like $res->content, qr/name='larry'/, "session value looks good"; +}; + +done_testing; diff --git a/t/session_engines.t b/t/session_engines.t new file mode 100644 index 00000000..d0ae52d5 --- /dev/null +++ b/t/session_engines.t @@ -0,0 +1,117 @@ +use strict; +use warnings; +use Test::More; +use YAML; +use Plack::Test; +use HTTP::Cookies; +use HTTP::Request::Common; + +use File::Spec; +use File::Basename 'dirname'; + +my $SESSION_DIR; +BEGIN { + $SESSION_DIR = File::Spec->catfile( dirname(__FILE__), 'sessions' ); +} + +{ + package App; + use Dancer2; + my @to_destroy; + + set engines => { session => { YAML => { session_dir => $SESSION_DIR } } }; + + hook 'engine.session.before_destroy' => sub { + my $session = shift; + push @to_destroy, $session; + }; + + get '/set_session/*' => sub { + my ($name) = splat; + session name => $name; + }; + + get '/read_session' => sub { + my $name = session('name') || ''; + "name='$name'"; + }; + + get '/clear_session' => sub { + session name => undef; + return exists( session->data->{'name'} ) ? "failed" : "cleared"; + }; + + get '/cleanup' => sub { + app->destroy_session; + return scalar(@to_destroy); + }; + + setting session => 'Simple'; + + set( + show_errors => 1, + environment => 'production', + ); +} + +my $url = "http://localhost"; +my $test = Plack::Test->create( App->to_app ); +my $app = Dancer2->runner->apps->[0]; + +my @clients = qw(one two three); + +for my $engine ( qw(YAML Simple) ) { + # clear current session engine, and rebuild for the test + # This is *really* messy, playing in object hashrefs.. + delete $app->{session_engine}; + $app->config->{session} = $engine; + $app->session_engine; # trigger a build + + # run the tests for this engine + for my $client (@clients) { + my $jar = HTTP::Cookies->new; + + subtest "[$engine][$client] Empty session" => sub { + my $res = $test->request( GET "$url/read_session" ); + like $res->content, qr/name=''/, + "empty session for client $client"; + $jar->extract_cookies($res); + }; + + subtest "[$engine][$client] set_session" => sub { + my $req = GET "$url/set_session/$client"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok( $res->is_success, "set_session for client $client" ); + $jar->extract_cookies($res); + }; + + subtest "[$engine][$client] session for client" => sub { + my $req = GET "$url/read_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + like $res->content, qr/name='$client'/, + "session looks good for client $client"; + $jar->extract_cookies($res); + }; + + subtest "[$engine][$client] delete session" => sub { + my $req = GET "$url/clear_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + like $res->content, qr/cleared/, "deleted session key"; + }; + + subtest "[$engine][$client] cleanup" => sub { + my $req = GET "$url/cleanup"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok( $res->is_success, "cleanup done for $client" ); + ok( $res->content, "session hook triggered" ); + }; + } +} + + + +done_testing; diff --git a/t/session_forward.t b/t/session_forward.t new file mode 100644 index 00000000..6136cd70 --- /dev/null +++ b/t/session_forward.t @@ -0,0 +1,195 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Cookies; +use HTTP::Request::Common; + +{ + package Test::Forward::Single; + use Dancer2; + + set session => 'Simple'; + + get '/main' => sub { + session foo => 'Single/main'; + forward '/outer'; + }; + + get '/outer' => sub { + session bar => 'Single/outer'; + forward '/inner'; + }; + + get '/inner' => sub { + session baz => 'Single/inner'; + return join ':', map +( session($_) || '' ), qw<foo bar baz>; + }; + + get '/clear' => sub { + session foo => undef; + session bar => undef; + session baz => undef; + }; +} + +{ + package Test::Forward::Multi::SameCookieName; + use Dancer2; + set session => 'Simple'; + prefix '/same'; + + get '/main' => sub { + session foo => 'SameCookieName/main'; + forward '/outer'; + }; + + get '/bad_chain' => sub { + session foo => 'SameCookieName/bad_chain'; + forward '/other/main'; + }; +} + +{ + package Test::Forward::Multi::OtherCookieName; + use Dancer2; + set engines => { + session => { Simple => { cookie_name => 'session.dancer' } } + }; + + set session => 'Simple'; + prefix '/other'; + + get '/main' => sub { + session foo => 'OtherCookieName/main'; + # Forwards to another app with different cookie name + forward '/outer'; + }; + + get '/clear' => sub { + session foo => undef; + session bar => undef; + session baz => undef; + }; +} + +# base uri for all requests. +my $base = 'http://localhost'; + +subtest 'Forwards within a single app' => sub { + my $test = Plack::Test->create( Test::Forward::Single->to_app ); + my $jar = HTTP::Cookies->new; + + { + my $res = $test->request( GET "$base/main" ); + is( + $res->content, + q{Single/main:Single/outer:Single/inner}, + 'session value preserved after chained forwards', + ); + + $jar->extract_cookies($res); + } + + { + my $req = GET "$base/inner"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + is( + $res->content, + q{Single/main:Single/outer:Single/inner}, + 'session values preserved between calls', + ); + + $jar->extract_cookies($res); + } + + { + my $req = GET "$base/clear"; + $jar->add_cookie_header($req); + + my $res = $test->request( GET "$base/clear" ); + $jar->extract_cookies($res); + } + + { + my $req = GET "$base/outer"; + $jar->add_cookie_header($req); + + my $res = $test->request( GET "$base/outer" ); + is( + $res->content, + q{:Single/outer:Single/inner}, + 'session value preserved after forward from route', + ); + + $jar->extract_cookies($res); + } +}; + +subtest 'Forwards between multiple apps using the same cookie name' => sub { + my $test = Plack::Test->create( Dancer2->psgi_app ); + my $jar = HTTP::Cookies->new; + + { + my $res = $test->request( GET "$base/same/main" ); + is( + $res->content, + q{SameCookieName/main:Single/outer:Single/inner}, + 'session value preserved after chained forwards between apps', + ); + + $jar->extract_cookies($res); + } + + { + my $req = GET "$base/outer"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + is( + $res->content, + q{SameCookieName/main:Single/outer:Single/inner}, + 'session value preserved after forward from route', + ); + } +}; + +subtest 'Forwards between multiple apps using different cookie names' => sub { + my $test = Plack::Test->create( Dancer2->psgi_app ); + my $jar = HTTP::Cookies->new; + my $res = $test->request( GET "$base/other/main" ); + + is( + $res->content, + q{:Single/outer:Single/inner}, + 'session value only from forwarded app', + ); +}; + +# we need to make sure B doesn't override A when forwarding to C +# A -> B -> C +# This means that A (cookie_name "Homer") +# forwarding to B (cookie_name "Marge") +# forwarding to C (cookie_name again "Homer") +# will cause a problem because we will lose "Homer" session data, +# because it will be overwritten by "Marge" session data. +# Suddenly A and C cannot communicate because it was flogged. +# +# if A -> Single, B -> OtherCookieName, C -> SameCookieName +# call A, create session, then forward to B, create session, +# then forward to C, check has values as in A and C +subtest 'Forwards between multiple apps using multiple different cookie names' => sub { + my $test = Plack::Test->create( Dancer2->psgi_app ); + my $jar = HTTP::Cookies->new; + my $res = $test->request( GET "$base/same/bad_chain" ); + + is( + $res->content, + q{SameCookieName/bad_chain:Single/outer:Single/inner}, + 'session value only from apps with same session cookie name', + ); +}; + +done_testing; diff --git a/t/session_hooks.t b/t/session_hooks.t new file mode 100644 index 00000000..701b156a --- /dev/null +++ b/t/session_hooks.t @@ -0,0 +1,190 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Cookies; +use HTTP::Request::Common; + +my @hooks_to_test = qw( + engine.session.before_retrieve + engine.session.after_retrieve + + engine.session.before_create + engine.session.after_create + + engine.session.before_change_id + engine.session.after_change_id + + engine.session.before_destroy + engine.session.after_destroy + + engine.session.before_flush + engine.session.after_flush +); + +# we'll set a flag here when each hook is called. Then our test will then verify this +my $test_flags = {}; + +{ + package App; + use Dancer2; + + set( + show_errors => 1, + envoriment => 'production' + ); + + setting( session => 'Simple' ); + + for my $hook (@hooks_to_test) { + hook $hook => sub { + $test_flags->{$hook} ||= 0; + $test_flags->{$hook}++; + } + } + + get '/set_session' => sub { + session foo => 'bar'; #setting causes a session flush + return "ok"; + }; + + get '/get_session' => sub { + ::is session->read('foo'), 'bar', "Got the right session back"; + return "ok"; + }; + + get '/change_session_id' => sub { + app->change_session_id; + return "ok"; + }; + + get '/destroy_session' => sub { + app->destroy_session; + return "ok"; + }; + + #setup each hook again and test whether they return the correct type + #there is unfortunately quite some duplication here. + hook 'engine.session.before_create' => sub { + my ($response) = @_; + ::isa_ok( $response, 'Dancer2::Core::Session' ); + }; + + hook 'engine.session.after_create' => sub { + my ($response) = @_; + ::isa_ok( $response, 'Dancer2::Core::Session' ); + }; + + hook 'engine.session.after_retrieve' => sub { + my ($response) = @_; + ::isa_ok( $response, 'Dancer2::Core::Session' ); + }; +} + +my $test = Plack::Test->create( App->to_app ); +my $jar = HTTP::Cookies->new; +my $url = "http://localhost"; + +is_deeply( $test_flags, {}, 'Make sure flag hash is clear' ); + +subtest set_session => sub { + my $res = $test->request( GET "$url/set_session" ); + is $res->content, "ok", "set_session ran ok"; + $jar->extract_cookies($res); +}; + +# we verify whether the hooks were called correctly. +subtest 'verify hooks for session create and session flush' => sub { + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create called"; + is $test_flags->{'engine.session.before_flush'}, 1, "session.before_flush called"; + is $test_flags->{'engine.session.after_flush'}, 1, "session.after_flush called"; + + is $test_flags->{'engine.session.before_change_id'}, undef, "session.before_change_id not called"; + is $test_flags->{'engine.session.after_change_id'}, undef, "session.after_change_id not called"; + is $test_flags->{'engine.session.before_retrieve'}, undef, "session.before_retrieve not called"; + is $test_flags->{'engine.session.after_retrieve'}, undef, "session.after_retrieve not called"; + is $test_flags->{'engine.session.before_destroy'}, undef, "session.before_destroy not called"; + is $test_flags->{'engine.session.after_destroy'}, undef, "session.after_destroy not called"; +}; + +subtest 'verify Handler::File (static content) does not retrieve session' => sub { + my $req = GET "$url/file.txt"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + $jar->extract_cookies($res); + + # These should not change from previous subtest + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create not called"; + is $test_flags->{'engine.session.before_retrieve'}, undef, "session.before_retrieve not called"; + is $test_flags->{'engine.session.after_retrieve'}, undef, "session.after_retrieve not called"; +}; + +subtest get_session => sub { + my $req = GET "$url/get_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + is $res->content, "ok", "get_session ran ok"; + $jar->extract_cookies($res); +}; + +subtest 'verify hooks for session retrieve' => sub { + is $test_flags->{'engine.session.before_retrieve'}, 1, "session.before_retrieve called"; + is $test_flags->{'engine.session.after_retrieve'}, 1, "session.after_retrieve called"; + + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create not called"; + is $test_flags->{'engine.session.before_flush'}, 1, "session.before_flush not called"; + is $test_flags->{'engine.session.after_flush'}, 1, "session.after_flush not called"; + is $test_flags->{'engine.session.before_change_id'}, undef, "session.before_change_id not called"; + is $test_flags->{'engine.session.after_change_id'}, undef, "session.after_change_id not called"; + is $test_flags->{'engine.session.before_destroy'}, undef, "session.before_destroy not called"; + is $test_flags->{'engine.session.after_destroy'}, undef, "session.after_destroy not called"; +}; + +subtest change_session_id => sub { + my $req = GET "$url/change_session_id"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + is $res->content, "ok", "get_session ran ok"; + $jar->clear; + $jar->extract_cookies($res); +}; + +subtest 'verify hooks for change session id' => sub { + # change_session_id causes a retrieve + is $test_flags->{'engine.session.before_retrieve'}, 2, "session.before_retrieve called"; + is $test_flags->{'engine.session.after_retrieve'}, 2, "session.after_retrieve called"; + + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create not called"; + is $test_flags->{'engine.session.before_flush'}, 1, "session.before_flush not called"; + is $test_flags->{'engine.session.after_flush'}, 1, "session.after_flush not called"; + is $test_flags->{'engine.session.before_change_id'}, 1, "session.before_change_id called"; + is $test_flags->{'engine.session.after_change_id'}, 1, "session.after_change_id called"; + is $test_flags->{'engine.session.before_destroy'}, undef, "session.before_destroy not called"; + is $test_flags->{'engine.session.after_destroy'}, undef, "session.after_destroy not called"; +}; + +subtest destroy_session => sub { + my $req = GET "$url/destroy_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + is $res->content, "ok", "destroy_session ran ok"; +}; + +subtest 'verify session destroy hooks' => sub { + is $test_flags->{'engine.session.before_destroy'}, 1, "session.before_destroy called"; + is $test_flags->{'engine.session.after_destroy'}, 1, "session.after_destroy called"; + #not sure if before and after retrieve should be called when the session is destroyed. But this happens. + is $test_flags->{'engine.session.before_retrieve'}, 3, "session.before_retrieve called"; + is $test_flags->{'engine.session.after_retrieve'}, 3, "session.after_retrieve called"; + + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create not called"; + is $test_flags->{'engine.session.before_flush'}, 1, "session.before_flush not called"; + is $test_flags->{'engine.session.after_flush'}, 1, "session.after_flush not called"; +}; + +done_testing; diff --git a/t/session_hooks_no_change_id.t b/t/session_hooks_no_change_id.t new file mode 100644 index 00000000..3a733a13 --- /dev/null +++ b/t/session_hooks_no_change_id.t @@ -0,0 +1,195 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Cookies; +use HTTP::Request::Common; +use lib 't/lib'; + +my @hooks_to_test = qw( + engine.session.before_retrieve + engine.session.after_retrieve + + engine.session.before_create + engine.session.after_create + + engine.session.before_change_id + engine.session.after_change_id + + engine.session.before_destroy + engine.session.after_destroy + + engine.session.before_flush + engine.session.after_flush +); + +# we'll set a flag here when each hook is called. Then our test will then verify this +my $test_flags = {}; + +{ + package App; + use Dancer2; + + set( + show_errors => 1, + envoriment => 'production' + ); + + setting( session => 'SimpleNoChangeId' ); + + for my $hook (@hooks_to_test) { + hook $hook => sub { + $test_flags->{$hook} ||= 0; + $test_flags->{$hook}++; + } + } + + get '/set_session' => sub { + session foo => 'bar'; #setting causes a session flush + return "ok"; + }; + + get '/get_session' => sub { + ::is session->read('foo'), 'bar', "Got the right session back"; + return "ok"; + }; + + get '/change_session_id' => sub { + app->change_session_id; + return "ok"; + }; + + get '/destroy_session' => sub { + app->destroy_session; + return "ok"; + }; + + #setup each hook again and test whether they return the correct type + #there is unfortunately quite some duplication here. + hook 'engine.session.before_create' => sub { + my ($response) = @_; + ::isa_ok( $response, 'Dancer2::Core::Session' ); + }; + + hook 'engine.session.after_create' => sub { + my ($response) = @_; + ::isa_ok( $response, 'Dancer2::Core::Session' ); + }; + + hook 'engine.session.after_retrieve' => sub { + my ($response) = @_; + ::isa_ok( $response, 'Dancer2::Core::Session' ); + }; +} + +my $test = Plack::Test->create( App->to_app ); +my $jar = HTTP::Cookies->new; +my $url = "http://localhost"; + +is_deeply( $test_flags, {}, 'Make sure flag hash is clear' ); + +subtest set_session => sub { + my $res = $test->request( GET "$url/set_session" ); + is $res->content, "ok", "set_session ran ok"; + $jar->extract_cookies($res); +}; + +# we verify whether the hooks were called correctly. +subtest 'verify hooks for session create and session flush' => sub { + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create called"; + is $test_flags->{'engine.session.before_flush'}, 1, "session.before_flush called"; + is $test_flags->{'engine.session.after_flush'}, 1, "session.after_flush called"; + + is $test_flags->{'engine.session.before_change_id'}, undef, "session.before_change_id not called"; + is $test_flags->{'engine.session.after_change_id'}, undef, "session.after_change_id not called"; + is $test_flags->{'engine.session.before_retrieve'}, undef, "session.before_retrieve not called"; + is $test_flags->{'engine.session.after_retrieve'}, undef, "session.after_retrieve not called"; + is $test_flags->{'engine.session.before_destroy'}, undef, "session.before_destroy not called"; + is $test_flags->{'engine.session.after_destroy'}, undef, "session.after_destroy not called"; +}; + +subtest 'verify Handler::File (static content) does not retrieve session' => sub { + my $req = GET "$url/file.txt"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + $jar->extract_cookies($res); + + # These should not change from previous subtest + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create not called"; + is $test_flags->{'engine.session.before_retrieve'}, undef, "session.before_retrieve not called"; + is $test_flags->{'engine.session.after_retrieve'}, undef, "session.after_retrieve not called"; +}; + +subtest get_session => sub { + my $req = GET "$url/get_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + is $res->content, "ok", "get_session ran ok"; + $jar->extract_cookies($res); +}; + +subtest 'verify hooks for session retrieve' => sub { + is $test_flags->{'engine.session.before_retrieve'}, 1, "session.before_retrieve called"; + is $test_flags->{'engine.session.after_retrieve'}, 1, "session.after_retrieve called"; + + is $test_flags->{'engine.session.before_create'}, 1, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 1, "session.after_create not called"; + is $test_flags->{'engine.session.before_flush'}, 1, "session.before_flush not called"; + is $test_flags->{'engine.session.after_flush'}, 1, "session.after_flush not called"; + is $test_flags->{'engine.session.before_change_id'}, undef, "session.before_change_id not called"; + is $test_flags->{'engine.session.after_change_id'}, undef, "session.after_change_id not called"; + is $test_flags->{'engine.session.before_destroy'}, undef, "session.before_destroy not called"; + is $test_flags->{'engine.session.after_destroy'}, undef, "session.after_destroy not called"; +}; + +subtest change_session_id => sub { + my $req = GET "$url/change_session_id"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + is $res->content, "ok", "get_session ran ok"; + $jar->clear; + $jar->extract_cookies($res); +}; + +subtest 'verify hooks for change session id' => sub { + # change_session_id causes a retrieve + is $test_flags->{'engine.session.before_retrieve'}, 2, "session.before_retrieve called"; + is $test_flags->{'engine.session.after_retrieve'}, 2, "session.after_retrieve called"; + + # and a new session is created since this engine doesn't have _change_id + is $test_flags->{'engine.session.before_create'}, 2, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 2, "session.after_create not called"; + # flushed as well + is $test_flags->{'engine.session.before_flush'}, 2, "session.before_flush not called"; + is $test_flags->{'engine.session.after_flush'}, 2, "session.after_flush not called"; + # these should never be called + is $test_flags->{'engine.session.before_change_id'}, undef, "session.before_change_id not called"; + is $test_flags->{'engine.session.after_change_id'}, undef, "session.after_change_id not called"; + # and the old session was destroyed + is $test_flags->{'engine.session.before_destroy'}, 1, "session.before_destroy not called"; + is $test_flags->{'engine.session.after_destroy'}, 1, "session.after_destroy not called"; +}; + +subtest destroy_session => sub { + my $req = GET "$url/destroy_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + is $res->content, "ok", "destroy_session ran ok"; +}; + +subtest 'verify session destroy hooks' => sub { + is $test_flags->{'engine.session.before_destroy'}, 2, "session.before_destroy called"; + is $test_flags->{'engine.session.after_destroy'}, 2, "session.after_destroy called"; + #not sure if before and after retrieve should be called when the session is destroyed. But this happens. + is $test_flags->{'engine.session.before_retrieve'}, 3, "session.before_retrieve called"; + is $test_flags->{'engine.session.after_retrieve'}, 3, "session.after_retrieve called"; + + is $test_flags->{'engine.session.before_create'}, 2, "session.before_create not called"; + is $test_flags->{'engine.session.after_create'}, 2, "session.after_create not called"; + is $test_flags->{'engine.session.before_flush'}, 2, "session.before_flush not called"; + is $test_flags->{'engine.session.after_flush'}, 2, "session.after_flush not called"; +}; + +done_testing; diff --git a/t/session_in_template.t b/t/session_in_template.t new file mode 100644 index 00000000..0979e4db --- /dev/null +++ b/t/session_in_template.t @@ -0,0 +1,98 @@ +use strict; +use warnings; +use Test::More; + +use Plack::Test; +use HTTP::Request::Common; +use HTTP::Cookies; +use Ref::Util qw<is_coderef>; + +{ + package TestApp; + + use Dancer2; + + get '/' => sub { + template 'session_in_template' + }; + + get '/set_session/*' => sub { + my ($name) = splat; + session name => $name; + template 'session_in_template'; + }; + + get '/destroy_session' => sub { + # Need to call the 'session' keyword, so app->setup_session + # is called and the session attribute in the engines is populated + my $name = session 'name'; + # Destroying the session should remove the session object from + # all engines. + app->destroy_session; + template 'session_in_template'; + }; + + setting( + engines => { + session => { 'Simple' => { session_dir => 't/sessions' } } + } + ); + setting( session => 'Simple' ); +} + +my $app = TestApp->to_app; +ok( is_coderef($app), 'Got app' ); + +my $test = Plack::Test->create($app); +my $jar = HTTP::Cookies->new(); +my $base = 'http://localhost'; + +{ + my $res = $test->request( GET "$base/" ); + + ok $res->is_success, 'Successful request'; + is $res->content, "session.name \n"; + + $jar->extract_cookies($res); +} + +{ + my @requests = ( + GET("$base/set_session/test_name"), + GET("$base/") + ); + for my $req ( @requests ) { + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok $res->is_success, 'Successful request'; + is $res->content, "session.name test_name\n"; + + $jar->extract_cookies($res); + } +} + +{ + my $request = GET "$base/"; + $jar->add_cookie_header($request); + + my $res = $test->request($request); + ok $res->is_success, 'Successful request'; + is $res->content, "session.name test_name\n"; + + $jar->extract_cookies($res); +} + + +{ + my $request = GET "$base/destroy_session"; + $jar->add_cookie_header($request); + + my $res = $test->request($request); + ok $res->is_success, 'Successful request'; + is $res->content, "session.name \n"; + + $jar->extract_cookies($res); +} + +done_testing(); diff --git a/t/session_lifecycle.t b/t/session_lifecycle.t new file mode 100644 index 00000000..644e6cc9 --- /dev/null +++ b/t/session_lifecycle.t @@ -0,0 +1,227 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use HTTP::Cookies; +use lib 't/lib'; + +{ + package App; + use Dancer2; + + set session => 'Simple'; + set show_errors => 1; + + get '/no_session_data' => sub { + return "session not modified"; + }; + + get '/set_session/*' => sub { + my ($name) = splat; + session name => $name; + }; + + get '/read_session' => sub { + my $name = session('name') || ''; + "name='$name'"; + }; + + get '/change_session_id' => sub { + app->change_session_id; + }; + + get '/destroy_session' => sub { + my $name = session('name') || ''; + app->destroy_session; + return "destroyed='$name'"; + }; + + get '/churn_session' => sub { + app->destroy_session; + session name => 'damian'; + return "churned"; + }; +} + +my $url = 'http://localhost'; +my $test = Plack::Test->create( App->to_app ); +my $app = Dancer2->runner->apps->[0]; + +for my $engine (qw(YAML Simple SimpleNoChangeId)) { + + # clear current session engine, and rebuild for the test + # This is *really* messy, playing in object hashrefs.. + delete $app->{session_engine}; + $app->config->{session} = $engine; + $app->session_engine; # trigger a build + + my $jar = HTTP::Cookies->new(); + + subtest "[$engine] No cookie set if session not referenced" => sub { + my $res = $test->request(GET "$url/no_session_data"); + ok $res->is_success, "/no_session_data" + or diag explain $res; + + $jar->extract_cookies($res); + ok(!$jar->as_string, 'No cookie set'); + }; + + subtest "[$engine] No empty session created if session read attempted" => + sub { + my $res = $test->request(GET "$url/read_session"); + ok $res->is_success, "/read_session"; + + $jar->extract_cookies($res); + ok(!$jar->as_string, 'No cookie set'); + }; + + my $sid1; + subtest "[$engine] Set value into session" => sub { + my $res = $test->request(GET "$url/set_session/larry"); + ok $res->is_success, "/set_session/larry"; + + $jar->extract_cookies($res); + ok($jar->as_string, 'Cookie set'); + + # extract SID + $jar->scan(sub { $sid1 = $_[2] }); + ok($sid1, 'Got SID from cookie'); + }; + + subtest "[$engine] Read value back" => sub { + + # read value back + my $req = GET "$url/read_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok $res->is_success, "/read_session"; + + $jar->clear; + ok(!$jar->as_string, 'Jar cleared'); + + $jar->extract_cookies($res); + ok($jar->as_string, 'session cookie set again'); + like $res->content, qr/name='larry'/, "session value looks good"; + }; + + subtest + "[$engine] Session cookie persists even if we do not touch sessions" => + sub { + my $req = GET "$url/no_session_data"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok $res->is_success, "/no_session_data"; + + $jar->clear; + ok(!$jar->as_string, 'Jar cleared'); + + $jar->extract_cookies($res); + ok($jar->as_string, 'session cookie set again'); + }; + + my $sid2; + subtest "[$engine] Change session ID" => sub { + my $req = GET "$url/change_session_id"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok $res->is_success, "/change_session_id"; + + $jar->clear; + ok(!$jar->as_string, 'Jar cleared'); + + $jar->extract_cookies($res); + ok($jar->as_string, 'session cookie set again'); + + # extract SID + $jar->scan(sub { $sid2 = $_[2] }); + isnt $sid2, $sid1, "New session has different ID"; + is $res->content, $sid2, "new session ID returned"; + }; + + subtest "[$engine] Read value back after change_session_id" => sub { + + # read value back + my $req = GET "$url/read_session"; + $jar->add_cookie_header($req); + my $res = $test->request($req); + ok $res->is_success, "/read_session"; + + $jar->clear; + ok(!$jar->as_string, 'Jar cleared'); + + $jar->extract_cookies($res); + ok($jar->as_string, 'session cookie set again'); + like $res->content, qr/name='larry'/, "session value looks good"; + }; + + subtest + "[$engine] Destroy session and check that cookies expiration is set" => + sub { + my $req = GET "$url/destroy_session"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok $res->is_success, "/destroy_session"; + + ok($jar->as_string, 'We have a cookie before reading response'); + $jar->extract_cookies($res); + ok(!$jar->as_string, 'Cookie was removed from jar'); + }; + + subtest "[$engine] Session cookie not sent after session destruction" => + sub { + my $req = GET "$url/no_session_data"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok $res->is_success, "/no_session_data"; + + ok(!$jar->as_string, 'Jar is empty'); + $jar->extract_cookies($res); + ok(!$jar->as_string, 'Jar still empty (no new session cookie)'); + }; + + my $sid3; + subtest "[$engine] Set value into session again" => sub { + my $res = $test->request(GET "$url/set_session/curly"); + ok $res->is_success, "/set_session/larry"; + + $jar->extract_cookies($res); + ok($jar->as_string, 'session cookie set'); + + # extract SID + $jar->scan(sub { $sid3 = $_[2] }); + isnt $sid3, $sid2, "New session has different ID"; + }; + + subtest "[$engine] Destroy and create a session in one request" => sub { + my $req = GET "$url/churn_session"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok $res->is_success, "/churn_session"; + + $jar->extract_cookies($res); + ok($jar->as_string, 'session cookie set'); + + my $sid4; + $jar->scan(sub { $sid4 = $_[2] }); + isnt $sid4, $sid3, "Changed session has different ID"; + }; + + subtest "[$engine] Read value back" => sub { + my $req = GET "$url/read_session"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + ok $res->is_success, "/read_session"; + + $jar->extract_cookies($res); + ok($jar->as_string, "session cookie set"); + like $res->content, qr/name='damian'/, "session value looks good"; + }; +} + +done_testing; diff --git a/t/session_object.t b/t/session_object.t new file mode 100644 index 00000000..1263158a --- /dev/null +++ b/t/session_object.t @@ -0,0 +1,50 @@ +# session_object.t + +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Dancer2::Core::Session; +use Dancer2::Session::Simple; + +my $ENGINE = Dancer2::Session::Simple->new; + +my $CPRNG_AVAIL = eval { require Math::Random::ISAAC::XS; 1; } + && eval { require Crypt::URandom; 1; }; + +note $CPRNG_AVAIL + ? "Crypto strength tokens" + : "Default strength tokens"; + +subtest 'session attributes' => sub { + my $s1 = $ENGINE->create; + + my $id = $s1->id; + ok defined($id), 'id is defined'; + is(exception { $s1->id("new_$id") }, undef, 'id can be set'); + is($s1->id, "new_$id", '... new value found for id'); + + my $s2 = $ENGINE->create; + isnt($s1->id, $s2->id, "IDs are not the same"); +}; + +my $count = 10_000; +subtest "$count session IDs and no dups" => sub { + my $seen = {}; + my $iteration = 0; + foreach my $i (1 .. $count) { + my $s1 = $ENGINE->create; + my $id = $s1->id; + if (exists $seen->{$id}) { + last; + } + $seen->{$id} = 1; + $iteration++; + } + + is $iteration, $count, + "no duplicate ID after $count iterations (done $iteration)"; +}; + +done_testing; diff --git a/t/shared_engines.t b/t/shared_engines.t new file mode 100644 index 00000000..00c4226e --- /dev/null +++ b/t/shared_engines.t @@ -0,0 +1,51 @@ +use strict; +use warnings; +use Test::More; +use Plack::Test; +use HTTP::Cookies; +use HTTP::Request::Common; + +{ + package App; + + # call stuff before next use() statement + BEGIN { + use Dancer2; + set session => 'Simple'; + engine('session')->{'__marker__'} = 1; + } + + use lib '.'; + use t::lib::Foo with => { session => engine('session') }; + + get '/main' => sub { + session( 'test' => 42 ); + }; +} + +my $jar = HTTP::Cookies->new; +my $url = 'http://localhost'; + +{ + my $test = Plack::Test->create( App->to_app ); + my $res = $test->request( GET "$url/main" ); + like $res->content, qr{42}, "session is set in main"; + $jar->extract_cookies($res); + + ok( $jar->as_string, 'Got cookie' ); +} + +{ + my $test = Plack::Test->create( t::lib::Foo->to_app ); + my $req = GET "$url/in_foo"; + $jar->add_cookie_header($req); + + my $res = $test->request($req); + like $res->content, qr{42}, "session is set in foo"; +} + +my $engine = t::lib::Foo->dsl->engine('session'); +is $engine->{__marker__}, 1, + "the session engine in subapp is the same"; + +done_testing; diff --git a/t/static_content.t b/t/static_content.t new file mode 100644 index 00000000..a31cd3ea --- /dev/null +++ b/t/static_content.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use utf8; + +use Test::More; +use Plack::Test; +use HTTP::Request::Common; + +{ + package PublicContent; + use Dancer2; + + set public_dir => 't/corpus/static'; + + get '/' => sub { return 'Welcome Home' }; + +} + +my $test = Plack::Test->create( PublicContent->to_app ); + +subtest 'public content' => sub { + my $res = $test->request( GET '/1x1.png' ); + is $res->code, 200, "200 response"; + my $last_modified = $res->header('Last-Modified'); + + $res = $test->request( GET '/1x1.png', 'If-Modified-Since' => $last_modified ); + is $res->code, 304, "304 response"; +}; + +done_testing(); diff --git a/t/template.t b/t/template.t new file mode 100644 index 00000000..e75ccad1 --- /dev/null +++ b/t/template.t @@ -0,0 +1,199 @@ +use strict; +use warnings; +use Test::More; +use Dancer2::Core::Hook; +use Plack::Test; +use HTTP::Request::Common; + +use File::Spec; +use File::Basename 'dirname'; + +eval { require Template; Template->import(); 1 } + or plan skip_all => 'Template::Toolkit probably missing.'; + +use_ok('Dancer2::Template::TemplateToolkit'); + +my $views = + File::Spec->rel2abs( File::Spec->catfile( dirname(__FILE__), 'views' ) ); + +my $tt = Dancer2::Template::TemplateToolkit->new( + views => $views, + layout => 'main.tt', + layout_dir => 'layouts', +); + +isa_ok $tt, 'Dancer2::Template::TemplateToolkit'; +ok $tt->does('Dancer2::Core::Role::Template'); + +$tt->add_hook( + Dancer2::Core::Hook->new( + name => 'engine.template.before_render', + code => sub { + my $tokens = shift; + $tokens->{before_template_render} = 1; + }, + ) +); + +$tt->add_hook( + Dancer2::Core::Hook->new( + name => 'engine.template.before_layout_render', + code => sub { + my $tokens = shift; + my $content = shift; + + $tokens->{before_layout_render} = 1; + $$content .= "\ncontent added in before_layout_render"; + }, + ) +); + +$tt->add_hook( + Dancer2::Core::Hook->new( + name => 'engine.template.after_layout_render', + code => sub { + my $content = shift; + $$content .= "\ncontent added in after_layout_render"; + }, + ) +); + +$tt->add_hook( + Dancer2::Core::Hook->new( + name => 'engine.template.after_render', + code => sub { + my $content = shift; + $$content .= 'content added in after_template_render'; + }, + ) +); + +{ + package Bar; + use Dancer2; + + # set template engine for first app + Dancer2->runner->apps->[0]->set_template_engine($tt); + + get '/' => sub { template index => { var => 42 } }; + + # Call template as a global keyword + my $global= template( index => { var => 21 } ); + get '/global' => sub { $global }; +} + +subtest 'template hooks' => sub { + my $space = " "; + my $result = "layout top +var = 42 +before_layout_render = 1 +--- +[index] +var = 42 + +before_layout_render =$space +before_template_render = 1 +content added in after_template_render +content added in before_layout_render +--- +layout bottom + +content added in after_layout_render"; + + my $test = Plack::Test->create( Bar->to_app ); + my $res = $test->request( GET '/' ); + is $res->content, $result, '[GET /] Correct content with template hooks'; + + $result =~ s/42/21/g; + $res = $test->request( GET '/global' ); + is $res->content, $result, '[GET /global] Correct content with template hooks'; +}; + +{ + + package Foo; + + use Dancer2; + set views => '/this/is/our/path'; + + get '/default_views' => sub { set 'views' }; + get '/set_views_via_settings' => sub { set views => '/other/path' }; + get '/get_views_via_settings' => sub { set 'views' }; + + get '/default_layout_dir' => sub { app->template_engine->layout_dir }; + get '/set_layout_dir_via_settings' => sub { set layout_dir => 'alt_layout' }; + get '/get_layout_dir_via_settings' => sub { set 'layout_dir' }; + +} + +subtest "modify views - absolute paths" => sub { + + my $test = Plack::Test->create( Foo->to_app ); + + is( + $test->request( GET '/default_views' )->content, + '/this/is/our/path', + '[GET /default_views] Correct content', + ); + + # trigger a test via a route + $test->request( GET '/set_views_via_settings' ); + + is( + $test->request( GET '/get_views_via_settings' )->content, + '/other/path', + '[GET /get_views_via_settings] Correct content', + ); +}; + +subtest "modify layout_dir" => sub { + my $test = Plack::Test->create( Foo->to_app ); + + is( + $test->request( GET '/default_layout_dir' )->content, + 'layouts', + '[GET /default_layout_dir] Correct layout dir', + ); + + # trigger a test via a route + $test->request( GET '/set_layout_dir_via_settings' ); + + is( + $test->request( GET '/get_layout_dir_via_settings' )->content, + 'alt_layout', + '[GET /get_layout_dir_via_settings] Correct content', + ); +}; + +{ + package Baz; + use Dancer2; + + set template => 'template_toolkit'; + + get '/set_views/**' => sub { + my ($view) = splat; + set views => join('/', @$view ); + }; + + get '/:file' => sub { + template param('file'); + }; +} + +subtest "modify views propagates to TT2 via dynamic INCLUDE_PATH" => sub { + + my $test = Plack::Test->create( Baz->to_app ); + + my $res = $test->request( GET '/index' ); + is $res->code, 200, 'got template from views'; + + # Change views - this is an existing test corpus.. + $test->request( GET '/set_views/t/corpus/pretty' ); + + # Get another template that is known to exist in the test corpus + $res = $test->request( GET '/relative.tt' ); + is $res->code, 200, 'got template from other view'; +}; + +done_testing; diff --git a/t/template_default_tokens.t b/t/template_default_tokens.t new file mode 100644 index 00000000..b298a0a1 --- /dev/null +++ b/t/template_default_tokens.t @@ -0,0 +1,55 @@ +use strict; +use warnings; +use File::Spec; +use File::Basename 'dirname'; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +eval { require Template; Template->import(); 1 } + or plan skip_all => 'Template::Toolkit probably missing.'; + +my $views = + File::Spec->rel2abs( File::Spec->catfile( dirname(__FILE__), 'views' ) ); + +{ + + package Foo; + + use Dancer2; + set session => 'Simple'; + + set views => $views; + set template => "template_toolkit"; + set foo => "in settings"; + + get '/view/:foo' => sub { + var foo => "in var"; + session foo => "in session"; + template "tokens"; + }; +} + +my $version = Dancer2->VERSION; +my $expected = "perl_version: $^V +dancer_version: ${version} +settings.foo: in settings +params.foo: 42 +session.foo in session +vars.foo: in var"; + +my $app = Foo->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + like( + $cb->( GET '/view/42' )->content, + qr{$expected}, + 'Response contains all expected tokens', + ); +}; + +done_testing; diff --git a/t/template_ext.t b/t/template_ext.t new file mode 100644 index 00000000..4fce202d --- /dev/null +++ b/t/template_ext.t @@ -0,0 +1,29 @@ +use strict; +use warnings; +use Test::More; + +eval { require Template; Template->import(); 1 } + or plan skip_all => 'Template::Toolkit probably missing.'; + +use Dancer2; + +set engines => { + template => { + template_toolkit => { + extension => 'foo', + }, + }, +}; +set template => 'template_toolkit'; + +my $tt = engine('template'); +isa_ok( $tt, 'Dancer2::Template::TemplateToolkit' ); +is( $tt->default_tmpl_ext, 'foo', + "Template extension is 'foo' as configured", +); + +is( $tt->view_pathname('foo'), 'foo.foo' , + "view('foo') gives filename with right extension as configured", +); + +done_testing; diff --git a/t/template_name.t b/t/template_name.t new file mode 100644 index 00000000..83ce8b75 --- /dev/null +++ b/t/template_name.t @@ -0,0 +1,29 @@ +use strict; +use warnings; +use File::Spec; +use File::Basename 'dirname'; +use Test::More; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + + package Foo; + + use Dancer2; + + get '/template_name' => sub { + return engine('template')->name; + }; +} + +my $app = Foo->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + is( $cb->( GET '/template_name' )->content, 'Tiny', 'template name' ); +}; + +done_testing; diff --git a/t/template_simple.t b/t/template_simple.t new file mode 100644 index 00000000..85436a5e --- /dev/null +++ b/t/template_simple.t @@ -0,0 +1,89 @@ +use Test::More tests => 9; + +use strict; +use warnings; +use Dancer2::FileUtils 'path'; + +use Dancer2::Template::Simple; + +{ + package Foo; + use Moo; + + has x => ( is => 'rw'); + has y => ( is => 'rw'); + + sub method { "yeah" } +} + +# variable interpolation, with file-based template + +my $engine = Dancer2::Template::Simple->new; +my $template = path('t', 'views', 'template_simple_index.tt'); + +my $result = $engine->render( + $template, + { var1 => "xxx", + var2 => "yyy", + foo => 'one', + bar => 'two', + baz => 'three'}); + +my $expected = 'this is var1="xxx" and var2=yyy'."\n\nanother line\n\n one two three\n\nxxx/xxx\n"; +is $result, $expected, "template got processed successfully"; + +# variable interpolation, with scalar-based template + +$expected = "one=1, two=2, three=3 - 77"; +$template = "one=<% one %>, two=<% two %>, three=<% three %> - <% hash.key %>"; + +eval { $engine->render($template, { one => 1, two => 2, three => 3}) }; +like $@, qr/Can't open .* using mode '<'/, "prototype failure detected"; + +$result = $engine->render(\$template, { + one => 1, two => 2, three => 3, + hash => { key => 77 }, +}); +is $result, $expected, "processed a template given as a scalar ref"; + +# complex variable interpolation (object, coderef and hash) + +my $foo = Foo->new; +$foo->x(42); + +$template = 'foo->x == <% foo.x %> foo.method == <% foo.method %> foo.dumb=\'<% foo.dumb %>\''; +$expected = 'foo->x == 42 foo.method == yeah foo.dumb=\'\''; +$result = $engine->render(\$template, { foo => $foo }); +is $result, $expected, 'object are interpolated in templates'; + +$template = 'code = <% code %>, code <% hash.code %>'; +$expected = 'code = 42, code 42'; +$result = $engine->render(\$template, { + code => sub { 42 }, + hash => { + code => sub { 42 } + } + }); +is $result, $expected, 'code ref are interpolated in templates'; + +$template = 'array: <% array %>, hash.array: <% hash.array %>'; +$expected = 'array: 1 2 3 4 5, hash.array: 6 7 8'; +$result = $engine->render(\$template, { + array => [1, 2, 3, 4, 5], + hash => { array => [6, 7, 8] }}); +is $result, $expected, "arrayref are interpolated in templates"; + +# if-then-else +$template = '<% if want %>hello<% else %>goodbye<% end %> world'; +$result = $engine->render(\$template, {want => 1}); +is $result, 'hello world', "true boolean condition matched"; +$result = $engine->render(\$template, {want => 0}); +is $result, 'goodbye world', "false boolean condition matched"; + +$template = 'one: 1 +two: <% two %> +three : <% three %>'; +$result = $engine->render(\$template, {two => 2, three => 3 }); +is $result, 'one: 1 +two: 2 +three : 3', "multiline template processed"; diff --git a/t/template_tiny/01_compile.t b/t/template_tiny/01_compile.t new file mode 100644 index 00000000..c167e7e2 --- /dev/null +++ b/t/template_tiny/01_compile.t @@ -0,0 +1,11 @@ +#!/usr/bin/env perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Test::More tests => 1; + +use_ok('Dancer2::Template::Implementation::ForkedTiny'); diff --git a/t/template_tiny/02_trivial.t b/t/template_tiny/02_trivial.t new file mode 100644 index 00000000..0c81b6ef --- /dev/null +++ b/t/template_tiny/02_trivial.t @@ -0,0 +1,34 @@ +#!/usr/bin/env perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Test::More tests => 1; +use Dancer2::Template::Implementation::ForkedTiny (); + +sub process { + my $stash = shift; + my $input = shift; + my $expected = shift; + my $message = shift || 'Template processed ok'; + my $output = ''; + Dancer2::Template::Implementation::ForkedTiny->new->process( + \$input, + $stash, \$output + ); + is( $output, $expected, $message ); +} + + +###################################################################### +# Main Tests + +process( { foo => 'World' }, + <<'END_TEMPLATE', <<'END_EXPECTED', 'Trivial ok' ); +Hello [% foo %]! +END_TEMPLATE +Hello World! +END_EXPECTED diff --git a/t/template_tiny/03_samples.t b/t/template_tiny/03_samples.t new file mode 100644 index 00000000..30a8c66c --- /dev/null +++ b/t/template_tiny/03_samples.t @@ -0,0 +1,110 @@ +#!/usr/bin/env perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use vars qw{$VAR1 $VAR2}; +use Test::More; +use File::Spec::Functions ':ALL'; +use Dancer2::Template::Implementation::ForkedTiny (); +use FindBin qw($Bin); +use Ref::Util qw<is_hashref>; + +my $SAMPLES = catdir( $Bin, 'samples' ); +unless ( -d $SAMPLES ) { + die("Failed to find samples directory"); +} + +opendir( DIR, $SAMPLES ) or die("opendir($SAMPLES): $!"); +my @TEMPLATES = sort grep {/\.tt$/} readdir(DIR); +closedir(DIR) or die("closedir($SAMPLES): $!"); + +plan( tests => scalar(@TEMPLATES) * 6 ); + +# Test the test classes +#SCOPE: { +# my $false = bless { }, 'False'; +# my $string = $false . ''; +# is( $string, 'Hello', 'False objects return ok as a string' ); +# is( !!$false, '', 'False objects returns false during bool' ); +#} + + +###################################################################### +# Main Tests + +foreach my $template (@TEMPLATES) { + $template =~ s/\.tt$//; + my $file = catfile( $SAMPLES, $template ); + my $tt_file = "$file.tt"; + my $var_file = "$file.var"; + my $txt_file = "$file.txt"; + ok( -f $tt_file, "$template: Found $tt_file" ); + ok( -f $txt_file, "$template: Found $txt_file" ); + ok( -f $var_file, "$template: Found $var_file" ); + + # Load the resources + my $tt = slurp($tt_file); + my $var = slurp($var_file); + my $txt = slurp($txt_file); + eval $var; + die $@ if $@; + ok( is_hashref($VAR1), "$template: Loaded stash from file" ); + + # Create the processor normally + my %params = ( INCLUDE_PATH => $SAMPLES, ); + %params = ( %params, %$VAR2 ) if $VAR2; + my $template = Dancer2::Template::Implementation::ForkedTiny->new(%params); + isa_ok( $template, 'Dancer2::Template::Implementation::ForkedTiny' ); + + # Execute the template + $template->process( \$tt, $VAR1, \my $out ); + is( $out, $txt, "$template: Output matches expected" ); +} + +sub slurp { + my $f = shift; + local $/ = undef; + open( VAR, $f ) or die("open($f): $!"); + my $buffer = <VAR>; + close VAR; + return $buffer; +} + + +###################################################################### +# Support Classes for object tests + +SCOPE: { + + package UpperCase; + + sub foo { + uc $_[0]->{foo}; + } + + 1; +} + +SCOPE: { + + package False; + + use overload 'bool' => sub {0}; + use overload '""' => sub {'Hello'}; + + 1; +} + +SCOPE: { + + package Private; + + sub public {'foo'} + sub _private {'foo'} + + 1; +} diff --git a/t/template_tiny/04_compat.t b/t/template_tiny/04_compat.t new file mode 100644 index 00000000..b81cc992 --- /dev/null +++ b/t/template_tiny/04_compat.t @@ -0,0 +1,107 @@ +#!/usr/bin/env perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use vars qw{$VAR1 $VAR2}; +use Test::More; +use File::Spec::Functions ':ALL'; +eval "require Template"; +if ($@) { + plan( skip_all => 'Template Toolkit is not installed' ); +} +use Ref::Util qw<is_hashref>; +use FindBin qw($Bin); +my $SAMPLES = catdir( $Bin, 'samples' ); +unless ( -d $SAMPLES ) { + die("Failed to find samples directory"); +} + +opendir( DIR, $SAMPLES ) or die("opendir($SAMPLES): $!"); +my @TEMPLATES = sort grep {/\.tt$/} readdir(DIR); +closedir(DIR) or die("closedir($SAMPLES): $!"); + +plan( tests => scalar(@TEMPLATES) * 7 ); + + +###################################################################### +# Main Tests + +foreach my $name (@TEMPLATES) { + $name =~ s/\.tt$//; + my $file = catfile( $SAMPLES, $name ); + my $tt_file = "$file.tt"; + my $var_file = "$file.var"; + my $txt_file = "$file.txt"; + ok( -f $tt_file, "$name: Found $tt_file" ); + ok( -f $txt_file, "$name: Found $txt_file" ); + ok( -f $var_file, "$name: Found $var_file" ); + + # Load the resources + my $tt = slurp($tt_file); + my $var = slurp($var_file); + my $txt = slurp($txt_file); + eval $var; + die $@ if $@; + ok( is_hashref($VAR1), "$name: Loaded stash from file" ); + + # Create the template processor + my %params = ( INCLUDE_PATH => $SAMPLES, ); + %params = ( %params, %$VAR2 ) if $VAR2; + my $template = Template->new(%params); + isa_ok( $template, 'Template' ); + + # Execute the template + my $out = ''; + ok( $template->process( \$tt, $VAR1, \$out ), + "$name: ->process returns true" + ); + is( $out, $txt, "$name: Output matches expected" ); +} + +sub slurp { + my $f = shift; + local $/ = undef; + open( VAR, $f ) or die("open($f): $!"); + my $buffer = <VAR>; + close VAR; + return $buffer; +} + + +###################################################################### +# Support Classes for object tests + +SCOPE: { + + package UpperCase; + + sub foo { + uc $_[0]->{foo}; + } + + 1; +} + +SCOPE: { + + package False; + + use overload 'bool' => sub {0}; + use overload '""' => sub {'Hello'}; + + 1; +} + +SCOPE: { + + package Private; + + sub public {'foo'} + sub _private {'foo'} + + 1; +} diff --git a/t/template_tiny/05_preparse.t b/t/template_tiny/05_preparse.t new file mode 100644 index 00000000..51c2c36c --- /dev/null +++ b/t/template_tiny/05_preparse.t @@ -0,0 +1,69 @@ +#!/usr/bin/env perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Test::More tests => 6; +use Dancer2::Template::Implementation::ForkedTiny (); + +sub preprocess { + my $template = $_[0]; + my $expected = $_[1]; + my $message = $_[2] || 'Template preprocessd ok'; + my $prepared = + Dancer2::Template::Implementation::ForkedTiny->new->preprocess( + $template); + is( $prepared, $expected, $message ); + is( $template, $_[0], + '->proprocess does not modify original template variable' + ); +} + + +###################################################################### +# Main Tests + +preprocess( <<'END_TEMPLATE', <<'END_EXPECTED', 'Simple IF' ); +foo +[% IF foo %] +foobar +[% END %] +bar +END_TEMPLATE +foo +[% I1 foo %] +foobar +[% I1 %] +bar +END_EXPECTED + +preprocess( <<'END_TEMPLATE', <<'END_EXPECTED', 'Simple UNLESS' ); +foo +[% UNLESS foo %] +foobar +[% END %] +bar +END_TEMPLATE +foo +[% U1 foo %] +foobar +[% U1 %] +bar +END_EXPECTED + +preprocess( <<'END_TEMPLATE', <<'END_EXPECTED', 'Simple FOREACH' ); +foo +[% FOREACH element IN lists %] +foobar +[% END %] +bar +END_TEMPLATE +foo +[% F1 element IN lists %] +foobar +[% F1 %] +bar +END_EXPECTED diff --git a/t/template_tiny/samples/01_hello.tt b/t/template_tiny/samples/01_hello.tt new file mode 100644 index 00000000..e91b5288 --- /dev/null +++ b/t/template_tiny/samples/01_hello.tt @@ -0,0 +1,8 @@ +Hello [% foo %]! +Hello [%foo%]! +Hello [% foo %]! +Hello [% +foo +%]! +Hello +[% foo %]! diff --git a/t/template_tiny/samples/01_hello.txt b/t/template_tiny/samples/01_hello.txt new file mode 100644 index 00000000..831dc24b --- /dev/null +++ b/t/template_tiny/samples/01_hello.txt @@ -0,0 +1,6 @@ +Hello World! +Hello World! +Hello World! +Hello World! +Hello +World! diff --git a/t/template_tiny/samples/01_hello.var b/t/template_tiny/samples/01_hello.var new file mode 100644 index 00000000..ebf5ab24 --- /dev/null +++ b/t/template_tiny/samples/01_hello.var @@ -0,0 +1,3 @@ +$VAR1 = { + 'foo' => 'World' + }; diff --git a/t/template_tiny/samples/02_null.tt b/t/template_tiny/samples/02_null.tt new file mode 100644 index 00000000..a068237b --- /dev/null +++ b/t/template_tiny/samples/02_null.tt @@ -0,0 +1 @@ +a[% foo %]b[% bar %]c[% foo %]d diff --git a/t/template_tiny/samples/02_null.txt b/t/template_tiny/samples/02_null.txt new file mode 100644 index 00000000..acbe86c7 --- /dev/null +++ b/t/template_tiny/samples/02_null.txt @@ -0,0 +1 @@ +abcd diff --git a/t/template_tiny/samples/02_null.var b/t/template_tiny/samples/02_null.var new file mode 100644 index 00000000..d41ea8c5 --- /dev/null +++ b/t/template_tiny/samples/02_null.var @@ -0,0 +1,3 @@ +$VAR1 = { + 'foo' => '', + }; diff --git a/t/template_tiny/samples/03_chomp.tt b/t/template_tiny/samples/03_chomp.tt new file mode 100644 index 00000000..07fe097e --- /dev/null +++ b/t/template_tiny/samples/03_chomp.tt @@ -0,0 +1,16 @@ +foo[%- a -%]bar +foo [%- a -%] bar +foo +[% a %] +bar +foo + + [%- a %] +bar +foo +[% a -%] + + bar +foo +[%- a -%] +bar diff --git a/t/template_tiny/samples/03_chomp.txt b/t/template_tiny/samples/03_chomp.txt new file mode 100644 index 00000000..030b3ffb --- /dev/null +++ b/t/template_tiny/samples/03_chomp.txt @@ -0,0 +1,12 @@ +foobar +foo bar +foo + +bar +foo + +bar +foo + + bar +foobar diff --git a/t/template_tiny/samples/03_chomp.var b/t/template_tiny/samples/03_chomp.var new file mode 100644 index 00000000..90f61a9c --- /dev/null +++ b/t/template_tiny/samples/03_chomp.var @@ -0,0 +1 @@ +$VAR1 = { }; diff --git a/t/template_tiny/samples/04_nested.tt b/t/template_tiny/samples/04_nested.tt new file mode 100644 index 00000000..ca17d502 --- /dev/null +++ b/t/template_tiny/samples/04_nested.tt @@ -0,0 +1,9 @@ +[% a %] +[% foo.one %] +[% foo.two %] +[% foo.three.0 %] +[% foo.three.1 %] +[% foo.three.2 %] +[% foo._private %] +[% bar.0.foo %] +[% bar.bad %] diff --git a/t/template_tiny/samples/04_nested.txt b/t/template_tiny/samples/04_nested.txt new file mode 100644 index 00000000..e82d2414 --- /dev/null +++ b/t/template_tiny/samples/04_nested.txt @@ -0,0 +1,9 @@ +b +1 +2 +1 +4 +9 + +bar + diff --git a/t/template_tiny/samples/04_nested.var b/t/template_tiny/samples/04_nested.var new file mode 100644 index 00000000..633b42bc --- /dev/null +++ b/t/template_tiny/samples/04_nested.var @@ -0,0 +1,14 @@ +$VAR1 = { + a => 'b', + foo => { + one => 1, + two => 2, + three => [ 1, 4, 9 ], + _private => 'secret', + }, + bar => [ + { + foo => 'bar', + }, + ], +}; diff --git a/t/template_tiny/samples/05_condition.tt b/t/template_tiny/samples/05_condition.tt new file mode 100644 index 00000000..2a74d091 --- /dev/null +++ b/t/template_tiny/samples/05_condition.tt @@ -0,0 +1,14 @@ + [%- IF foo %]World[% END %]! +Hello[% IF bar %] World[% END %]! +Hello[% UNLESS foo %] World[% END %]! +Hello[% UNLESS bar %] World[% END %]! +[% IF foo -%] +foo +[%- ELSE -%] +bar +[%- END -%] +[% IF bar %] +BAR +[% ELSE %] +FOO +[% END -%] diff --git a/t/template_tiny/samples/05_condition.txt b/t/template_tiny/samples/05_condition.txt new file mode 100644 index 00000000..7b9a9511 --- /dev/null +++ b/t/template_tiny/samples/05_condition.txt @@ -0,0 +1,6 @@ +World! +Hello! +Hello! +Hello World! +foo +FOO diff --git a/t/template_tiny/samples/05_condition.var b/t/template_tiny/samples/05_condition.var new file mode 100644 index 00000000..b07e4802 --- /dev/null +++ b/t/template_tiny/samples/05_condition.var @@ -0,0 +1,4 @@ +$VAR1 = { + 'foo' => 1, + 'bar' => 0, + }; diff --git a/t/template_tiny/samples/06_object.tt b/t/template_tiny/samples/06_object.tt new file mode 100644 index 00000000..371c535e --- /dev/null +++ b/t/template_tiny/samples/06_object.tt @@ -0,0 +1,5 @@ +[% foo.foo %] +[% bar %] +[% IF bar %]true[% ELSE %]false[% END %] +public = '[% baz.public %]' +private = '[% baz._private %]' diff --git a/t/template_tiny/samples/06_object.txt b/t/template_tiny/samples/06_object.txt new file mode 100644 index 00000000..dc621732 --- /dev/null +++ b/t/template_tiny/samples/06_object.txt @@ -0,0 +1,5 @@ +BAR +Hello +false +public = 'foo' +private = '' diff --git a/t/template_tiny/samples/06_object.var b/t/template_tiny/samples/06_object.var new file mode 100644 index 00000000..22cfc77b --- /dev/null +++ b/t/template_tiny/samples/06_object.var @@ -0,0 +1,5 @@ +$VAR1 = { + foo => bless( { foo => 'bar' }, 'UpperCase' ), + bar => bless( { }, 'False' ), + baz => bless( { }, 'Private' ), +}; diff --git a/t/template_tiny/samples/07_nesting.tt b/t/template_tiny/samples/07_nesting.tt new file mode 100644 index 00000000..4142817f --- /dev/null +++ b/t/template_tiny/samples/07_nesting.tt @@ -0,0 +1,20 @@ +[% IF true %] + one +[% END %] +[% IF false %] + two +[% END %] +[% IF true %] + [% IF true %] + three + [% END %] + [% IF false %] + four + [% END %] +[% END %] +[% IF true %] + five +[% END %] +[% IF false %] + six +[% END %]
\ No newline at end of file diff --git a/t/template_tiny/samples/07_nesting.txt b/t/template_tiny/samples/07_nesting.txt new file mode 100644 index 00000000..a040bd9d --- /dev/null +++ b/t/template_tiny/samples/07_nesting.txt @@ -0,0 +1,13 @@ + + one + + + + + three + + + + + five + diff --git a/t/template_tiny/samples/07_nesting.var b/t/template_tiny/samples/07_nesting.var new file mode 100644 index 00000000..351e95ba --- /dev/null +++ b/t/template_tiny/samples/07_nesting.var @@ -0,0 +1,4 @@ +$VAR1 = { + true => 1, + false => 0, +}; diff --git a/t/template_tiny/samples/08_foreach.tt b/t/template_tiny/samples/08_foreach.tt new file mode 100644 index 00000000..c186586e --- /dev/null +++ b/t/template_tiny/samples/08_foreach.tt @@ -0,0 +1,11 @@ +People [% foo %]: +[% FOREACH item IN list %] +[%- item.name %] <[% item.email %]> +[% END -%] +Cool People: +[% FOREACH item IN list %] +[%- IF item.cool %] +[%- item.name %] +[% END %] +[%- END -%] +Done! diff --git a/t/template_tiny/samples/08_foreach.txt b/t/template_tiny/samples/08_foreach.txt new file mode 100644 index 00000000..f246254f --- /dev/null +++ b/t/template_tiny/samples/08_foreach.txt @@ -0,0 +1,6 @@ +People bar: +Adam Kennedy <adamk@cpan.org> +Foo <No Fixed Address> +Cool People: +Adam Kennedy +Done! diff --git a/t/template_tiny/samples/08_foreach.var b/t/template_tiny/samples/08_foreach.var new file mode 100644 index 00000000..94db524e --- /dev/null +++ b/t/template_tiny/samples/08_foreach.var @@ -0,0 +1,15 @@ +$VAR1 = { + foo => 'bar', + list => [ + { + name => 'Adam Kennedy', + email => 'adamk@cpan.org', + cool => 1, + }, + { + name => 'Foo', + email => 'No Fixed Address', + cool => 0, + }, + ], +}; diff --git a/t/template_tiny/samples/09_trim.tt b/t/template_tiny/samples/09_trim.tt new file mode 100644 index 00000000..8862e04f --- /dev/null +++ b/t/template_tiny/samples/09_trim.tt @@ -0,0 +1,2 @@ + +Hello World! diff --git a/t/template_tiny/samples/09_trim.txt b/t/template_tiny/samples/09_trim.txt new file mode 100644 index 00000000..c57eff55 --- /dev/null +++ b/t/template_tiny/samples/09_trim.txt @@ -0,0 +1 @@ +Hello World!
\ No newline at end of file diff --git a/t/template_tiny/samples/09_trim.var b/t/template_tiny/samples/09_trim.var new file mode 100644 index 00000000..ebe3396b --- /dev/null +++ b/t/template_tiny/samples/09_trim.var @@ -0,0 +1,2 @@ +$VAR1 = {}; +$VAR2 = { TRIM => 1 }; diff --git a/t/time.t b/t/time.t new file mode 100644 index 00000000..9a6d2729 --- /dev/null +++ b/t/time.t @@ -0,0 +1,64 @@ +# time.t + +use strict; +use warnings; +use Test::More; + +my $mocked_epoch = 1355676244; # "Sun, 16-Dec-2012 16:44:04 GMT" + +# The order is important! +eval { require Test::MockTime; 1; } + or plan skip_all => 'Test::MockTime not present'; + +Test::MockTime::set_fixed_time($mocked_epoch); +require Dancer2::Core::Time; + +my @tests = ( + [ "1h" => 3600 => "Sun, 16-Dec-2012 17:44:04 GMT" ], + [ "1 hour" => 3600 => "Sun, 16-Dec-2012 17:44:04 GMT" ], + [ "+1 hour" => 3600 => "Sun, 16-Dec-2012 17:44:04 GMT" ], + [ "-1h" => -3600 => "Sun, 16-Dec-2012 15:44:04 GMT" ], + [ "1 hours" => 3600 => "Sun, 16-Dec-2012 17:44:04 GMT" ], + + [ "1d" => ( 3600 * 24 ) => "Mon, 17-Dec-2012 16:44:04 GMT" ], + [ "1 day" => ( 3600 * 24 ) => "Mon, 17-Dec-2012 16:44:04 GMT" ], + + +); + +foreach my $test (@tests) { + my ( $expr, $secs, $gmt_string ) = @$test; + + subtest "Expression: \"$expr\"" => sub { + my $t = Dancer2::Core::Time->new( expression => $expr ); + is $t->seconds, $secs, "\"$expr\" is $secs seconds"; + is $t->epoch, ( $t->seconds + $mocked_epoch ), + "... its epoch is " . $t->epoch; + is $t->gmt_string, $gmt_string, + "... and its GMT string is $gmt_string"; + }; +} + +subtest "Forcing another epoch in the object should work" => sub { + my $t = Dancer2::Core::Time->new( epoch => 1, expression => "1h" ); + is $t->seconds, 3600, "...1h is still 3600 seconds"; + is $t->epoch, 1, "... epoch is 1"; + is $t->gmt_string, 'Thu, 01-Jan-1970 00:00:01 GMT', + "... and is expressed as Thu, 01-Jan-1970 00:00:01 GMT"; +}; + +subtest "unparsable strings should be kept" => sub { + for my $t ( + [ "something silly", "something silly", "something silly" ], + [ "+2 something", "+2 something", "+2 something" ], + ) + { + my ( $expr, $secs, $gmt ) = @$t; + my $t = Dancer2::Core::Time->new( expression => $expr ); + is $t->seconds, $secs, "\"$expr\" is $secs seconds"; + is $t->epoch, $expr, "... its epoch is $expr"; + is $t->gmt_string, $gmt, "... and its GMT string is $gmt"; + } +}; + +done_testing; diff --git a/t/types.t b/t/types.t new file mode 100644 index 00000000..6b8b2db1 --- /dev/null +++ b/t/types.t @@ -0,0 +1,225 @@ +use strict; +use warnings; +use Test::More tests => 51; +use Test::Fatal; +use Dancer2::Core::Types; + + +ok( exception { Str->(undef) }, 'Str does not accept undef value', ); + +is( exception { Str->('something') }, undef, 'Str', ); + +like( + exception { Str->( { foo => 'something' } ) }, + qr{Reference.+foo.+something.+did not pass type constraint.+Str}, 'Str', +); + +is( exception { Num->(34) }, undef, 'Num', ); + +ok( exception { Num->(undef) }, 'Num does not accept undef value', ); + +like( + exception { Num->('not a number') }, + qr{not a number.+did not pass type constraint.+Num}, + 'Num fail', +); + +is( exception { Bool->(1) }, undef, 'Bool true value', ); + +is( exception { Bool->(0) }, undef, 'Bool false value', ); + +is( exception { Bool->(undef) }, undef, 'Bool does accepts undef value', ); + +like( + exception { Bool->('2') }, + qr{2.+did not pass type constraint.+Bool}, + 'Bool fail', +); + +is( exception { RegexpRef->(qr{.*}) }, undef, 'Regexp', ); + +like( + exception { RegexpRef->('/.*/') }, + qr{\Q/.*/\E.+did not pass type constraint.+RegexpRef}, + 'Regexp fail', +); + +ok( exception { RegexpRef->(undef) }, 'Regexp does not accept undef value', ); + +is( exception { HashRef->( { goo => 'le' } ) }, undef, 'HashRef', ); + +like( + exception { HashRef->('/.*/') }, + qr{\Q/.*/\E.+did not pass type constraint.+HashRef}, + 'HashRef fail', +); + +ok( exception { HashRef->(undef) }, 'HashRef does not accept undef value', ); + +is( exception { ArrayRef->( [ 1, 2, 3, 4 ] ) }, undef, 'ArrayRef', ); + +like( + exception { ArrayRef->('/.*/') }, + qr{\Q/.*/\E.+did not pass type constraint.+ArrayRef}, + 'ArrayRef fail', +); + +ok( exception { ArrayRef->(undef) }, 'ArrayRef does not accept undef value', ); + +is( exception { + CodeRef->( sub {44} ); + }, + undef, + 'CodeRef', +); + +like( + exception { CodeRef->('/.*/') }, + qr{\Q/.*/\E.+did not pass type constraint.+CodeRef}, + 'CodeRef fail', +); + +ok( exception { CodeRef->(undef) }, 'CodeRef does not accept undef value', ); + +{ + + package InstanceChecker::zad7; + use Moo; + use Dancer2::Core::Types; + has foo => ( is => 'ro', isa => InstanceOf ['Foo'] ); +} + +is( exception { InstanceChecker::zad7->new( foo => bless {}, 'Foo' ) }, + undef, 'InstanceOf', +); + +like( + exception { InstanceChecker::zad7->new( foo => bless {}, 'Bar' ) }, + qr{Reference bless.+Bar.+not isa Foo}, + 'InstanceOf fail', +); + +ok( exception { InstanceOf('Foo')->(undef) }, + 'InstanceOf does not accept undef value', +); + +is( exception { Dancer2Prefix->('/foo') }, undef, 'Dancer2Prefix', ); + +like( + exception { Dancer2Prefix->('bar/something') }, + qr{bar/something.+did not pass type constraint.+Dancer2Prefix}, + 'Dancer2Prefix fail', +); + +# see Dancer2Prefix definition, undef is a valid value +like( + exception { Dancer2Prefix->(undef) }, + qr/Undef.+did not pass type constraint.+Dancer2Prefix/, + 'Dancer2Prefix does not accept undef value', +); + +is( exception { Dancer2AppName->('Foo') }, undef, 'Dancer2AppName', ); + +is( exception { Dancer2AppName->('Foo::Bar') }, undef, 'Dancer2AppName', ); + +is( exception { Dancer2AppName->('Foo::Bar::Baz') }, undef, 'Dancer2AppName', +); + +like( + exception { Dancer2AppName->('Foo:Bar') }, + qr{Foo:Bar is not a Dancer2AppName}, + 'Dancer2AppName fails with single colons', +); + +like( + exception { Dancer2AppName->('Foo:::Bar') }, + qr{Foo:::Bar is not a Dancer2AppName}, + 'Dancer2AppName fails with tripe colons', +); + +like( + exception { Dancer2AppName->('7Foo') }, + qr{7Foo is not a Dancer2AppName}, + 'Dancer2AppName fails with beginning number', +); + +like( + exception { Dancer2AppName->('Foo::45Bar') }, + qr{Foo::45Bar is not a Dancer2AppName}, + 'Dancer2AppName fails with beginning number', +); + +like( + exception { Dancer2AppName->('-F') }, + qr{-F is not a Dancer2AppName}, + 'Dancer2AppName fails with special character', +); + +like( + exception { Dancer2AppName->('Foo::-') }, + qr{Foo::- is not a Dancer2AppName}, + 'Dancer2AppName fails with special character', +); + +like( + exception { Dancer2AppName->('Foo^') }, + qr{\QFoo^\E is not a Dancer2AppName}, + 'Dancer2AppName fails with special character', +); + +ok( exception { Dancer2AppName->(undef) }, + 'Dancer2AppName does not accept undef value', +); + +like( + exception { Dancer2AppName->('') }, + qr{Empty string is not a Dancer2AppName}, + 'Dancer2AppName fails an empty string value', +); + +is( exception { Dancer2Method->('post') }, undef, 'Dancer2Method', ); + +like( + exception { Dancer2Method->('POST') }, + qr{POST.+did not pass type constraint.+Dancer2Method}, + 'Dancer2Method fail', +); + +ok( exception { Dancer2Method->(undef) }, + 'Dancer2Method does not accept undef value', +); + +is( exception { Dancer2HTTPMethod->('POST') }, undef, 'Dancer2HTTPMethod', ); + +like( + exception { Dancer2HTTPMethod->('post') }, + qr{post.+did not pass type constraint.+Dancer2HTTPMethod}, + 'Dancer2HTTPMethod fail', +); + +ok( exception { Dancer2HTTPMethod->(undef) }, + 'Dancer2Method does not accept undef value', +); + +use Dancer2::Core::Error; +use Dancer2::Core::Hook; + +ok( exception { Hook->(undef) }, 'Hook does not accept undef value' ); + +ok(exception { Hook->(Dancer2::Core::Error->new) }, + 'Hook does not Core::Error as value'); + +is( exception { + Hook->(Dancer2::Core::Hook->new(name => 'test', code => sub { })) + }, + undef, + 'Hook', +); + +is(exception { ReadableFilePath->('t') }, undef, 'ReadableFilePath'); + +like( + exception { ReadableFilePath->('nosuchdirectory') }, + qr/Value "nosuchdirectory" did not pass type constraint "ReadableFilePath"/, + 'ReadableFilePath' +); diff --git a/t/uri_for.t b/t/uri_for.t new file mode 100644 index 00000000..7eff3478 --- /dev/null +++ b/t/uri_for.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +{ + package App; + use Dancer2; + get '/foo' => sub { + return uri_for('/foo'); + }; +} + +my $app = App->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + is( $cb->( GET '/foo' )->code, 200, '/foo code okay' ); + is( + $cb->( GET '/foo' )->content, + 'http://localhost/foo', + 'uri_for works as expected', + ); +}; + +done_testing; diff --git a/t/vars.t b/t/vars.t new file mode 100644 index 00000000..d4e4684b --- /dev/null +++ b/t/vars.t @@ -0,0 +1,35 @@ +use strict; +use warnings; +use Test::More import => ['!pass']; +use Plack::Test; +use HTTP::Request::Common; +use Ref::Util qw<is_coderef>; + +plan tests => 3; + +{ + use Dancer2; + + hook before => sub { + var( "xpto" => "foo" ); + vars->{zbr} = 'ugh'; + }; + + get '/bar' => sub { + var("xpto"); + }; + + get '/baz' => sub { + vars->{zbr}; + }; +} + +my $app = __PACKAGE__->to_app; +ok( is_coderef($app), 'Got app' ); + +test_psgi $app, sub { + my $cb = shift; + + is( $cb->( GET '/bar' )->content, 'foo', 'foo' ); + is( $cb->( GET '/baz' )->content, 'ugh', 'ugh' ); +}; diff --git a/t/views/auto_page.tt b/t/views/auto_page.tt new file mode 100644 index 00000000..7e09409d --- /dev/null +++ b/t/views/auto_page.tt @@ -0,0 +1 @@ +Hey! This is Auto Page wörking. diff --git a/t/views/beforetemplate.tt b/t/views/beforetemplate.tt new file mode 100644 index 00000000..ca64420e --- /dev/null +++ b/t/views/beforetemplate.tt @@ -0,0 +1 @@ +App is [% myname %], again, it is [% it %] diff --git a/t/views/folder/page.tt b/t/views/folder/page.tt new file mode 100644 index 00000000..0869e658 --- /dev/null +++ b/t/views/folder/page.tt @@ -0,0 +1 @@ +Page under folder. diff --git a/t/views/index.tt b/t/views/index.tt new file mode 100644 index 00000000..fdfd26ce --- /dev/null +++ b/t/views/index.tt @@ -0,0 +1,5 @@ +[index] +var = [% var %] + +before_layout_render = [% before_layout_render %] +before_template_render = [% before_template_render %] diff --git a/t/views/layouts/main.tt b/t/views/layouts/main.tt new file mode 100644 index 00000000..34b5d563 --- /dev/null +++ b/t/views/layouts/main.tt @@ -0,0 +1,7 @@ +layout top +var = [% var %] +before_layout_render = [% before_layout_render %] +--- +[% content %] +--- +layout bottom diff --git a/t/views/session_in_template.tt b/t/views/session_in_template.tt new file mode 100644 index 00000000..d8edb8c1 --- /dev/null +++ b/t/views/session_in_template.tt @@ -0,0 +1 @@ +session.name [% session.name %] diff --git a/t/views/template_simple_index.tt b/t/views/template_simple_index.tt new file mode 100644 index 00000000..d104948d --- /dev/null +++ b/t/views/template_simple_index.tt @@ -0,0 +1,7 @@ +this is var1="<% var1 %>" and var2=<% var2 %> + +another line + + <% foo%> <%bar %> <%baz%> + +<% var1 %>/<% var1 %> diff --git a/t/views/tokens.tt b/t/views/tokens.tt new file mode 100644 index 00000000..94e0f415 --- /dev/null +++ b/t/views/tokens.tt @@ -0,0 +1,6 @@ +perl_version: [% perl_version %] +dancer_version: [% dancer_version %] +settings.foo: [% settings.foo %] +params.foo: [% params.foo %] +session.foo [% session.foo %] +vars.foo: [% vars.foo %] diff --git a/xt/perlcritic.rc b/xt/perlcritic.rc new file mode 100644 index 00000000..a1ecaeb9 --- /dev/null +++ b/xt/perlcritic.rc @@ -0,0 +1,60 @@ +# nice output, to easily see the POD of the policy +verbose = [%p] %m at %f line %l, near '%r'\n +# severity of 3 is a good start (1 is very strict, 5 very tolerant) +severity = 3 +# we want to use // without //ms +[-RegularExpressions::RequireDotMatchAnything] +[-RegularExpressions::RequireLineBoundaryMatching] +[-RegularExpressions::RequireExtendedFormatting] +minimum_regex_length_to_complain_about = 5 +[-RegularExpressions::ProhibitComplexRegexes] +# we don't want these POD rules +[-Documentation::RequirePodSections] +# We don't care about POD links +[-Documentation::RequirePodLinksIncludeText] +# we use $@ and $! +[-Variables::ProhibitPunctuationVars] +# We want to be able to use Carp::Verbose in our tests scripts, so +# we add Carp to the whitelist +[Variables::ProhibitPackageVars] +packages = Data::Dumper File::Find FindBin Log::Log4perl Carp +[-ValuesAndExpressions::ProhibitEmptyQuotes] +# I really don't think q{/} is more readable than '/'... +[-ValuesAndExpressions::ProhibitNoisyQuotes] +# Perl::Critic recommends Readonly, but this IS BAD! +# we use Const::Fast instead, but this policy keeps poping up. +[-ValuesAndExpressions::ProhibitMagicNumbers] +# we want to be able to build DSLs +[-Modules::ProhibitAutomaticExportation] +# We only want the main module to provide $VERSION +[-Modules::RequireVersionVar] +# we want to be able to define short getters +[-Subroutines::RequireFinalReturn] +# we can't do @_ mesures with that one +[-Subroutines::RequireArgUnpacking] +# name is a common used name for methods +# but forbidden by this policy ... +[-Subroutines::ProhibitBuiltinHomonyms] +# some old libs use many args, we don't want to block that for now +[-Subroutines::ProhibitManyArgs] +# we allo protected subs +[-Subroutines::ProhibitUnusedPrivateSubroutines] +# We're not under CVS! :) +[-Miscellanea::RequireRcsKeywords] +[TestingAndDebugging::ProhibitNoStrict] +allow = refs +[TestingAndDebugging::ProhibitNoWarnings] +allow = redefine prototype +[TestingAndDebugging::RequireUseStrict] +equivalent_modules = strictures Moo Moo::Role +[TestingAndDebugging::RequireUseWarnings] +equivalent_modules = strictures Moo Moo::Role +# we use postifx controls +[-ControlStructures::ProhibitPostfixControls] +[-ControlStructures::ProhibitCascadingIfElse] +# We want to use croak everywhere instead of die +[ErrorHandling::RequireCarping] +# allow backtick if capture result +[InputOutput::ProhibitBacktickOperators] +only_in_void_context = 1 +[-Variables::ProhibitAugmentedAssignmentInDeclaration] diff --git a/xt/perltidy.rc b/xt/perltidy.rc new file mode 100644 index 00000000..03dce5e6 --- /dev/null +++ b/xt/perltidy.rc @@ -0,0 +1,33 @@ +-l=79 # Max line width is 79 cols +-i=4 # Indent level is 4 cols +-ci=4 # Continuation indent is 4 cols + +-se # Errors to STDERR +-vt=2 # Maximal vertical tightness +-cti=0 # No extra indentation for closing brackets +-pt=1 # Medium parenthesis tightness +-bt=1 # Medium brace tightness +-sbt=1 # Medium square bracket tightness +-bbt=1 # Medium block brace tightness +-nsfs # No space before semicolons +-nolq # Don't outdent long quoted strings +--break-at-old-comma-breakpoints +-wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" +# Break before all operators + +# extras/overrides/deviations from PBP +--maximum-line-length=79 # be less generous +--warning-output # Show warnings +--maximum-consecutive-blank-lines=2 # default is 1 +--nohanging-side-comments # troublesome for commented out code + +-isbc # block comments may only be indented if they have some space characters before the # +-ci=2 # Continuation indent is 2 cols + +# we use version control, so just rewrite the file +# -b # -- should not be active for dzil plugin + +## for the up-tight folk :) +#-pt=2 # High parenthesis tightness +#-bt=2 # High brace tightness +#-sbt=2 # High square bracket tightness diff --git a/xt/whitespace.t b/xt/whitespace.t new file mode 100644 index 00000000..52da40e2 --- /dev/null +++ b/xt/whitespace.t @@ -0,0 +1,16 @@ +use Test::Whitespaces { + + dirs => [qw( + lib + script + t + tools + xt + )], + + ignore => [ + qr{t/sessions/}, + qr{t/template_tiny/samples}, + ], + +}; |
