├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .proverc ├── Build.PL ├── Changes ├── LICENSE ├── META.json ├── README.md ├── README.mkdn ├── TODO ├── author ├── .gitignore ├── assets.pl └── test-externals.pl ├── cpanfile ├── eg ├── Hello │ ├── .gitignore │ ├── Hello.psgi │ ├── Makefile.PL │ ├── config │ │ └── development.pl │ ├── htdocs │ │ └── static │ │ │ └── css │ │ │ └── main.css │ ├── lib │ │ ├── Hello.pm │ │ └── Hello │ │ │ ├── ConfigLoader.pm │ │ │ ├── DB.pm │ │ │ ├── DB │ │ │ └── Schema.pm │ │ │ ├── Web.pm │ │ │ └── Web │ │ │ ├── C │ │ │ └── Root.pm │ │ │ ├── Dispatcher.pm │ │ │ ├── Request.pm │ │ │ └── Response.pm │ ├── script │ │ └── make_schema.pl │ ├── sql │ │ └── sqlite.sql │ ├── t │ │ ├── 01_root.t │ │ └── 02_mech.t │ ├── tmpl │ │ ├── include │ │ │ ├── footer.tt │ │ │ └── header.tt │ │ └── index.tt │ └── xt │ │ ├── 01_podspell.t │ │ ├── 02_perlcritic.t │ │ ├── 03_pod.t │ │ └── perlcriticrc ├── LongPoll │ ├── .gitignore │ ├── Makefile.PL │ └── chat.psgi ├── apps │ ├── DeepNamespace │ │ ├── .gitignore │ │ ├── DeepNamespace.psgi │ │ ├── Makefile.PL │ │ ├── lib │ │ │ ├── DeepNamespace.pm │ │ │ └── DeepNamespace │ │ │ │ ├── Config.pm │ │ │ │ ├── V │ │ │ │ ├── MT.pm │ │ │ │ └── MT │ │ │ │ │ └── Context.pm │ │ │ │ └── Web │ │ │ │ ├── Admin.pm │ │ │ │ ├── Admin │ │ │ │ ├── C │ │ │ │ │ └── Root.pm │ │ │ │ └── Dispatcher.pm │ │ │ │ ├── User.pm │ │ │ │ └── User │ │ │ │ ├── C │ │ │ │ └── Root.pm │ │ │ │ └── Dispatcher.pm │ │ ├── t │ │ │ └── 01_root.t │ │ └── tmpl │ │ │ ├── base.mt │ │ │ └── index.mt │ ├── Extended │ │ ├── .gitignore │ │ ├── Extended.psgi │ │ ├── Makefile.PL │ │ ├── lib │ │ │ ├── Extended.pm │ │ │ └── Extended │ │ │ │ ├── V │ │ │ │ └── MT │ │ │ │ │ └── Context.pm │ │ │ │ ├── Web.pm │ │ │ │ └── Web │ │ │ │ ├── C │ │ │ │ └── Root.pm │ │ │ │ ├── Dispatcher.pm │ │ │ │ └── Request.pm │ │ ├── t │ │ │ ├── 01_root.t │ │ │ ├── 02_die.t │ │ │ └── 03_session.t │ │ └── tmpl │ │ │ ├── base.mt │ │ │ └── index.mt │ └── SampleApp │ │ ├── SampleApp.psgi │ │ ├── lib │ │ ├── SampleApp.pm │ │ └── SampleApp │ │ │ ├── Config.pm │ │ │ ├── V │ │ │ └── MT │ │ │ │ └── Context.pm │ │ │ └── Web │ │ │ ├── C │ │ │ └── Root.pm │ │ │ └── Dispatcher.pm │ │ └── tmpl │ │ ├── base.mt │ │ └── index.mt └── realtime-chat │ └── chat.psgi ├── lib ├── Amon2.pm └── Amon2 │ ├── Config │ └── Simple.pm │ ├── ContextGuard.pm │ ├── Declare.pm │ ├── Plugin │ └── Web │ │ ├── FillInFormLite.pm │ │ ├── JSON.pm │ │ ├── NoCache.pm │ │ ├── PlackSession.pm │ │ ├── Streaming.pm │ │ └── WebSocket.pm │ ├── Setup │ ├── Asset │ │ ├── Blueprint.pm │ │ ├── Bootstrap.pm │ │ ├── MicroDispatcherJS.pm │ │ ├── MicroLocationJS.pm │ │ ├── MicroTemplateJS.pm │ │ ├── SprintfJS.pm │ │ ├── StrftimeJS.pm │ │ ├── XSRFTokenJS.pm │ │ └── jQuery.pm │ ├── Flavor.pm │ ├── Flavor │ │ ├── Basic.pm │ │ ├── Large.pm │ │ └── Minimum.pm │ └── VC │ │ └── Git.pm │ ├── Trigger.pm │ ├── Util.pm │ ├── Web.pm │ └── Web │ ├── Dispatcher │ ├── Lite.pm │ ├── RouterBoom.pm │ └── RouterSimple.pm │ ├── Request.pm │ ├── Response.pm │ ├── Response │ └── Callback.pm │ └── WebSocket.pm ├── minil.toml ├── script └── amon2-setup.pl ├── share └── flavor │ ├── Basic │ ├── config │ │ └── __ENV__.pl │ ├── db │ │ └── dot.gitignore │ ├── dot.gitignore │ ├── dot.proverc │ ├── lib │ │ ├── __PATH__.pm │ │ └── __PATH__ │ │ │ ├── DB.pm │ │ │ ├── DB │ │ │ ├── Row.pm │ │ │ └── Schema.pm │ │ │ ├── Web.pm │ │ │ └── Web │ │ │ ├── Dispatcher.pm │ │ │ └── Plugin │ │ │ └── Session.pm │ ├── script │ │ └── server.pl │ ├── sql │ │ ├── mysql.sql │ │ └── sqlite.sql │ ├── static │ │ ├── __STATUS__.html │ │ ├── css │ │ │ └── main.css │ │ └── js │ │ │ └── main.js │ ├── t │ │ ├── 00_compile.t │ │ ├── 03_assets.t │ │ ├── 06_jshint.t │ │ └── Util.pm │ ├── tmpl │ │ ├── include │ │ │ ├── layout.tx │ │ │ └── pager.tx │ │ └── index.tx │ └── xt │ │ └── 02_perlcritic.t │ ├── Large │ ├── lib │ │ └── __PATH__ │ │ │ ├── Web │ │ │ └── C │ │ │ │ └── Account.pm │ │ │ ├── __MONIKER__.pm │ │ │ └── __MONIKER__ │ │ │ ├── C │ │ │ └── Root.pm │ │ │ ├── Dispatcher.pm │ │ │ └── ViewFunctions.pm │ ├── script │ │ ├── admin.pl │ │ └── web.pl │ ├── sql │ │ ├── mysql.sql │ │ └── sqlite.sql │ ├── static │ │ └── admin │ │ │ └── css │ │ │ └── admin.css │ ├── t │ │ ├── 00_compile.t │ │ ├── 04_admin.t │ │ └── 07_mech_links.t │ └── tmpl │ │ ├── admin │ │ ├── error.tx │ │ ├── include │ │ │ ├── layout.tx │ │ │ └── sidebar.tx │ │ └── index.tx │ │ └── web │ │ └── error.tx │ └── Minimum │ ├── Build.PL │ ├── builder │ └── MyBuilder.pm │ ├── lib │ ├── __PATH__.pm │ └── __PATH__ │ │ ├── Web.pm │ │ └── Web │ │ ├── View.pm │ │ └── ViewFunctions.pm │ ├── minil.toml │ ├── script │ └── server.pl │ ├── t │ ├── 00_compile.t │ ├── 01_root.t │ ├── 02_mech.t │ └── Util.pm │ ├── tmpl │ └── index.tx │ └── xt │ └── 01_pod.t ├── t ├── 00_compile.t ├── 100_core │ ├── 001_request_param_decoded.t │ ├── 002_response.t │ ├── 003_redirect.t │ ├── 004_web_to_app_leak.t │ ├── 005_trigger.t │ ├── 008_request_uri_with.t │ ├── 009_uri_for.t │ ├── 010_add_config.t │ ├── 011_random_string.t │ ├── 012_trigger_controller.t │ ├── 013_tiffany.t │ ├── 014_load_plugins.t │ ├── 015_debug_mode.t │ ├── 016_context_guard.t │ └── 017_local_context.t ├── 200_app │ ├── 01_extended.t │ └── 02_deepnamespace.t ├── 300_setup │ ├── 01_minimum.t │ ├── 02_basic.t │ ├── 03_asset.t │ ├── 06_large.t │ ├── 07_run_cli_server.t │ ├── 08_installable.t │ └── 09_minil_migrate.t ├── 600_plugins │ ├── 005_fillin_form_lite.t │ ├── 007_json.t │ ├── 007_json_default_encoding.t │ ├── 007_json_hijacking.t │ ├── 007_json_keysort.t │ ├── 007_json_x_api_status.t │ ├── 008_no_cache.t │ ├── 010_plack_session.t │ ├── 012_streaming.t │ ├── 013_websocket.t │ └── 014_streaming_header_splitting.t ├── 800_dispatcher │ ├── 002_router_simple.t │ ├── 003_lite.t │ ├── 004_router_boom.t │ └── 004_router_boom_sinatraish.t ├── TestFlavor.pm ├── Util.pm └── tmpl │ └── foo.mt └── xt ├── 02_perlcritic.t ├── 06_dependencies.t └── skelton └── 01_basic.t /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | strategy: 13 | matrix: 14 | perl: [ 'latest', '5.30', '5.28', '5.10' ] 15 | name: Perl ${{ matrix.perl }} 16 | 17 | # Steps represent a sequence of tasks that will be executed as part of the job 18 | steps: 19 | - uses: actions/checkout@v2 20 | - name: Setup perl 21 | uses: shogo82148/actions-setup-perl@v1 22 | with: 23 | perl-version: ${{ matrix.perl }} 24 | - run: perl -V 25 | - run: cpanm --with-recommends --with-suggests --installdeps --notest . 26 | - run: prove -lvr t 27 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | inc/ 3 | META.yml 4 | Makefile 5 | blib/ 6 | inc/ 7 | pm_to_blib 8 | *.sw[po] 9 | ^\.git/ 10 | MANIFEST.bak 11 | *.old 12 | MANIFEST 13 | MYMETA.yml 14 | eg/Hello/Makefile 15 | eg/Hello/META.yml 16 | eg/Hello/test.db 17 | MYMETA.* 18 | MyApp/ 19 | ppport.h 20 | *.bak 21 | Build 22 | _build/ 23 | xshelper.h 24 | tags 25 | README 26 | ^inc/ 27 | Amon2-*/ 28 | /Amon2-* 29 | /.build 30 | /_build_params 31 | /Build 32 | !Build/ 33 | !META.json 34 | !LICENSE 35 | -------------------------------------------------------------------------------- /.proverc: -------------------------------------------------------------------------------- 1 | -I. 2 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | # ========================================================================= 2 | # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. 3 | # DO NOT EDIT DIRECTLY. 4 | # ========================================================================= 5 | 6 | use 5.008_001; 7 | use strict; 8 | 9 | use Module::Build::Tiny 0.035; 10 | 11 | Build_PL(); 12 | 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/tokuhirom/Amon.svg?branch=master)](https://travis-ci.org/tokuhirom/Amon) 2 | # NAME 3 | 4 | Amon2 - lightweight web application framework 5 | 6 | # SYNOPSIS 7 | 8 | package MyApp; 9 | use parent qw/Amon2/; 10 | use Amon2::Config::Simple; 11 | sub load_config { Amon2::Config::Simple->load(shift) } 12 | 13 | # DESCRIPTION 14 | 15 | Amon2 is simple, readable, extensible, **STABLE**, **FAST** web application framework based on [Plack](https://metacpan.org/pod/Plack). 16 | 17 | # METHODS 18 | 19 | ## CLASS METHODS for `Amon2` class 20 | 21 | - my $c = MyApp->context(); 22 | 23 | Get the context object. 24 | 25 | - MyApp->set\_context($c) 26 | 27 | Set your context object(INTERNAL USE ONLY). 28 | 29 | # CLASS METHODS for inherited class 30 | 31 | - `MyApp->config()` 32 | 33 | This method returns configuration information. It is generated by `MyApp->load_config()`. 34 | 35 | - `MyApp->mode_name()` 36 | 37 | This is a mode name for Amon2. The default implementation of this method is: 38 | 39 | sub mode_name { $ENV{PLACK_ENV} } 40 | 41 | You can override this method if you want to determine the mode by other method. 42 | 43 | - `MyApp->new()` 44 | 45 | Create new context object. 46 | 47 | - `MyApp->bootstrap()` 48 | 49 | my $c = MyApp->bootstrap(); 50 | 51 | Create new context object and set it to global context. When you are writing CLI script, setup the global context object by this method. 52 | 53 | - `MyApp->base_dir()` 54 | 55 | This method returns the application base directory. 56 | 57 | - `MyApp->load_plugin($module_name[, \%config])` 58 | 59 | This method loads the plugin for the application. 60 | 61 | _$module\_name_ package name of the plugin. You can write it as two form like [DBIx::Class](https://metacpan.org/pod/DBIx%3A%3AClass): 62 | 63 | __PACKAGE__->load_plugin("Web::CSRFDefender"); # => loads Amon2::Plugin::Web::CSRFDefender 64 | 65 | If you want to load a plugin in your own name space, use the '+' character before a package name, like following: 66 | \_\_PACKAGE\_\_->load\_plugin("+MyApp::Plugin::Foo"); # => loads MyApp::Plugin::Foo 67 | 68 | - `MyApp->load_plugins($module_name[, \%config ], ...)` 69 | 70 | Load multiple plugins at one time. 71 | 72 | If you want to load a plugin in your own name space, use the '+' character before a package name like following: 73 | 74 | __PACKAGE__->load_plugins("+MyApp::Plugin::Foo"); # => loads MyApp::Plugin::Foo 75 | 76 | - `MyApp->load_config()` 77 | 78 | You can get a configuration hashref from `config/$ENV{PLACK_ENV}.pl`. You can override this method for customizing configuration loading method. 79 | 80 | - `MyApp->add_config()` 81 | 82 | DEPRECATED. 83 | 84 | - `MyApp->debug_mode()` 85 | 86 | **((EXPERIMENTAL))** 87 | 88 | This method returns a boolean value. It returns true when $ENV{AMON2\_DEBUG} is true value, false otherwise. 89 | 90 | You can override this method if you need. 91 | 92 | # PROJECT LOCAL MODE 93 | 94 | **THIS MODE IS HIGHLY EXPERIMENTAL** 95 | 96 | Normally, Amon2's context is stored in a global variable. 97 | 98 | This module makes the context to project local. 99 | 100 | It means, normally context class using Amon2 use `$Amon2::CONTEXT` in each project, but context class using ["PROJECT LOCAL MODE"](#project-local-mode) use `$MyApp::CONTEXT`. 101 | 102 | **It means you can't use code depend `> and `> under this mode.**> 103 | 104 | ## NOTES ABOUT create\_request 105 | 106 | Older [Amon2::Web::Request](https://metacpan.org/pod/Amon2%3A%3AWeb%3A%3ARequest) has only 1 argument like following, it uses `Amon2->context` to get encoding: 107 | 108 | sub create_request { 109 | my ($class, $env) = @_; 110 | Amon2::Web::Request->new($env); 111 | } 112 | 113 | If you want to use ["PROJECT LOCAL MODE"](#project-local-mode), you need to pass class name of context class, as following: 114 | 115 | sub create_request { 116 | my ($class, $env) = @_; 117 | Amon2::Web::Request->new($env, $class); 118 | } 119 | 120 | ## HOW DO I ENABLE PROJECT LOCAL MODE? 121 | 122 | ` MyApp-`make\_local\_context() > turns on the project local mode. 123 | 124 | There is no way to revert it, thanks. 125 | 126 | ## METHODS 127 | 128 | This module inserts 3 methods to your context class. 129 | 130 | - MyApp->context() 131 | 132 | Shorthand for $MyApp::CONTEXT 133 | 134 | - MyApp->set\_context($context) 135 | 136 | It's the same as: 137 | 138 | $MyApp::CONTEXT = $context 139 | 140 | - my $guard = MyApp->context\_guard() 141 | 142 | Create new context guard class. 143 | 144 | It's the same as: 145 | 146 | Amon2::ContextGuard->new(shift, \$MyApp::CONTEXT); 147 | 148 | # DOCUMENTS 149 | 150 | More complicated documents are available on [http://amon.64p.org/](http://amon.64p.org/) 151 | 152 | # SUPPORTS 153 | 154 | \#amon at irc.perl.org is also available. 155 | 156 | # AUTHOR 157 | 158 | Tokuhiro Matsuno 159 | 160 | # CONTRIBUTORS 161 | 162 | - noblejasper 163 | - hiratara 164 | - s-aska 165 | - Kentaro Kuribayashi 166 | - Yuki Ibe 167 | - mattn 168 | - Masahiro Nagano 169 | - rightgo09 170 | - karupanerura 171 | - hatyuki 172 | - Keiji, Yoshimi 173 | - Nishibayashi Takuji 174 | - dragon3 175 | - Fuji, Goro 176 | - issm 177 | - hisaichi5518 178 | - Adrian 179 | - Fuji, Goro 180 | - ITO Nobuaki 181 | - Geraud CONTINSOUZAS 182 | - Syohei YOSHIDA 183 | - magnolia 184 | - Katsuhiro Konishi 185 | 186 | # LICENSE 187 | 188 | This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 189 | -------------------------------------------------------------------------------- /README.mkdn: -------------------------------------------------------------------------------- 1 | Amon2 - Yet another web application framework 2 | ============================================ 3 | 4 | - Supports PSGI/Plack. 5 | - Thin layer. 6 | - Lightweight. 7 | 8 | Full document available on http://amon.64p.org/ 9 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | plan for Amon3.0 2 | 3 | remove Amon2::Web::Dispatcher::Lite and use Router::Simple::Sinatraish directly... 4 | - easy facebook integration 5 | - easy twitter integration 6 | -------------------------------------------------------------------------------- /author/.gitignore: -------------------------------------------------------------------------------- 1 | externals/ 2 | -------------------------------------------------------------------------------- /author/test-externals.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use FindBin qw($Bin); 4 | use autodie; 5 | 6 | my @dist = ( 7 | 'Inamode13' => q{git://github.com/tokuhirom/Inamode13.git}, 8 | 'NoPaste' => q{git://github.com/tokuhirom/p5-OreOre-NoPaste.git}, 9 | ); 10 | 11 | my $distdir = 'externals'; 12 | 13 | chdir $Bin; 14 | mkdir $distdir if not -e $distdir; 15 | 16 | $ENV{ANY_MOOSE} = 'Mouse'; 17 | 18 | while(my($name, $repo) = splice @dist, 0, 2){ 19 | chdir "$Bin/$distdir"; 20 | 21 | print "Go $name ($repo)\n"; 22 | 23 | if(!(-e "$name")){ 24 | system "git clone $repo $name"; 25 | chdir $name; 26 | } 27 | else{ 28 | chdir $name; 29 | system "git pull"; 30 | } 31 | 32 | print "$^X Makefile.PL\n"; 33 | system("$^X Makefile.PL 2>&1 |tee ../$name.log"); 34 | 35 | print "make\n"; 36 | system("make 2>&1 >>../$name.log"); 37 | 38 | print "make test\n"; 39 | system("make test 2>&1 |tee -a ../$name.log") 40 | } 41 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires 'perl', '5.010000'; 2 | 3 | requires 'Encode'; 4 | requires 'Exporter'; 5 | requires 'File::Temp'; 6 | requires 'Getopt::Long'; 7 | requires 'Hash::MultiValue'; 8 | requires 'HTML::FillInForm::Lite'; 9 | requires 'HTTP::Headers'; 10 | requires 'JSON', '2'; 11 | requires 'mro'; 12 | requires 'parent', '0.223'; 13 | requires 'Plack', '0.9982'; 14 | requires 'Plack::Request'; 15 | requires 'Plack::Response'; 16 | requires 'Plack::Session'; 17 | requires 'Plack::Util'; 18 | requires 'Pod::Usage'; 19 | requires 'Router::Boom', '0.07'; 20 | requires 'Scalar::Util'; 21 | requires 'Text::Xslate', '2.0010'; 22 | requires 'Try::Tiny', '0.06'; 23 | requires 'URI', '1.54'; 24 | requires 'URI::Escape'; 25 | requires 'URI::QueryParam'; 26 | requires 'File::Copy::Recursive'; # setup script 27 | requires 'File::ShareDir'; 28 | requires 'Module::CPANfile', '0.9020'; 29 | requires 'HTTP::Session2'; 30 | requires 'Digest::SHA'; 31 | requires 'Time::HiRes'; 32 | requires 'MIME::Base64'; 33 | 34 | recommends 'Teng', 0.18; 35 | 36 | # HTTPSession 37 | suggests 'HTTP::Session'; 38 | 39 | # Websocket support 40 | suggests 'AnyEvent::Handle'; 41 | suggests 'Protocol::WebSocket', '0.00906'; 42 | suggests 'Protocol::WebSocket::Frame'; 43 | suggests 'Protocol::WebSocket::Handshake::Server'; 44 | 45 | on test => sub { 46 | requires 'Test::More', '0.98'; 47 | requires 'Test::Requires', '0.06'; 48 | 49 | suggests 'File::pushd'; 50 | suggests 'AnyEvent'; 51 | suggests 'AnyEvent::Socket'; 52 | suggests 'App::Prove'; 53 | suggests 'HTTP::Request::Common'; 54 | suggests 'HTTP::Session::Store::OnMemory'; 55 | suggests 'Plack::Builder'; 56 | suggests 'Plack::Middleware::Lint'; 57 | suggests 'Plack::Middleware::Session'; 58 | suggests 'Plack::Test'; 59 | suggests 'Test::TCP'; 60 | suggests 'Tiffany'; 61 | suggests 'Twiggy::Server'; 62 | suggests 'Test::WWW::Mechanize'; 63 | suggests 'App::cpanminus'; 64 | suggests 'File::Which'; 65 | suggests 'DBD::SQLite'; 66 | suggests 'Furl'; 67 | suggests 'Module::Functions'; 68 | suggests 'HTTP::MobileAgent'; 69 | suggests 'Text::MicroTemplate::Extended'; 70 | suggests 'Module::Find'; 71 | suggests 'Amon2::Plugin::LogDispatch'; 72 | suggests 'HTML::StickyQuery'; 73 | suggests 'Amon2::Plugin::Web::MobileAgent'; 74 | suggests 'Test::WWW::Mechanize::PSGI'; 75 | suggests 'Amon2::Plugin::Web::HTTPSession'; 76 | suggests 'Plack::Middleware::ReverseProxy'; 77 | suggests 'Starlet'; 78 | suggests 'Router::Simple::Sinatraish'; 79 | suggests 'Amon2::DBI'; 80 | suggests 'Crypt::Rijndael'; 81 | }; 82 | 83 | -------------------------------------------------------------------------------- /eg/Hello/.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | inc/ 3 | MANIFEST 4 | *.bak 5 | *.old 6 | nytprof.out 7 | test.db 8 | -------------------------------------------------------------------------------- /eg/Hello/Hello.psgi: -------------------------------------------------------------------------------- 1 | use File::Spec; 2 | use File::Basename; 3 | use local::lib File::Spec->catdir(dirname(__FILE__), 'extlib'); 4 | use lib File::Spec->catdir(dirname(__FILE__), 'lib'); 5 | use Hello::Web; 6 | use Plack::Builder; 7 | 8 | builder { 9 | enable 'Plack::Middleware::Static', 10 | path => qr{^/static/}, 11 | root => './htdocs/'; 12 | enable 'Plack::Middleware::ReverseProxy'; 13 | Hello::Web->to_app(); 14 | }; 15 | -------------------------------------------------------------------------------- /eg/Hello/Makefile.PL: -------------------------------------------------------------------------------- 1 | use inc::Module::Install; 2 | all_from "lib/Hello.pm"; 3 | 4 | tests 't/*.t t/*/*.t t/*/*/*.t'; 5 | requires 'Amon2'; 6 | requires 'Text::Xslate' => 1.5006; 7 | requires 'Plack::Middleware::ReverseProxy'; 8 | requires 'HTML::FillInForm::Lite'; 9 | requires 'Time::Piece'; 10 | 11 | requires 'DBIx::Skinny'; 12 | requires 'DBIx::Skinny::Schema::Loader'; 13 | 14 | recursive_author_tests('xt'); 15 | 16 | WriteAll; 17 | -------------------------------------------------------------------------------- /eg/Hello/config/development.pl: -------------------------------------------------------------------------------- 1 | +{ 2 | 3 | 'DBIx::Skinny' => { 4 | dsn => 'dbi:SQLite:dbname=test.db', 5 | username => '', 6 | password => '', 7 | }, 8 | 9 | 'Text::Xslate' => { 10 | path => ['tmpl/'], 11 | }, 12 | }; 13 | -------------------------------------------------------------------------------- /eg/Hello/htdocs/static/css/main.css: -------------------------------------------------------------------------------- 1 | /* reset.css */ 2 | html, body, div, span, object, iframe, h1, h2, h3, h4, h5, h6, p, blockquote, pre, a, abbr, acronym, address, code, del, dfn, em, img, q, dl, dt, dd, ol, ul, li, fieldset, form, label, legend, table, caption, tbody, tfoot, thead, tr, th, td {margin:0;padding:0;border:0;font-weight:inherit;font-style:inherit;font-size:100%;font-family:inherit;vertical-align:baseline;} 3 | body {line-height:1.5;} 4 | table {border-collapse:separate;border-spacing:0;} 5 | caption, th, td {text-align:left;font-weight:normal;} 6 | table, td, th {vertical-align:middle;} 7 | blockquote:before, blockquote:after, q:before, q:after {content:"";} 8 | blockquote, q {quotes:"" "";} 9 | a img {border:none;} 10 | 11 | /* main */ 12 | html,body {height:100%;} 13 | body > #Container {height:auto;} 14 | 15 | body { 16 | background-image: url(http://lab.rails2u.com/bgmaker/slash.png?margin=3&linecolor=FF0084&bgcolor=000000); 17 | color: white; 18 | font-family: "メイリオ","Hiragino Kaku Gothic Pro","ヒラギノ角ゴ Pro W3","ＭＳ Ｐゴシック","Osaka",sans-selif; 19 | } 20 | 21 | #Container { 22 | width: 780px; 23 | margin-left: auto; 24 | margin-right: auto; 25 | margin-bottom: 0px; 26 | border-left: black solid 1px; 27 | border-right: black solid 1px; 28 | margin-top: 0px; 29 | height: 100%; 30 | min-height:100%; 31 | background-color: white; 32 | color: black; 33 | } 34 | 35 | #Header { 36 | background-image: url(http://lab.rails2u.com/bgmaker/gradation.png?margin=3&linecolor=FF0084&bgcolor=000000); 37 | height: 50px; 38 | font-size: 36px; 39 | padding: 2px; 40 | text-align: center; 41 | } 42 | 43 | #Header a { 44 | color: black; 45 | font-weight: bold; 46 | text-decoration: none; 47 | } 48 | 49 | #Content { 50 | padding: 10px; 51 | } 52 | 53 | #FooterContainer { 54 | border-top: 1px solid black; 55 | font-size: 10px; 56 | color: black; 57 | position:absolute; 58 | bottom:0px; 59 | height:20px; 60 | width:780px; 61 | } 62 | #Footer { 63 | text-align: right; 64 | padding-right: 10px; 65 | padding-top: 2px; 66 | } 67 | 68 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello.pm: -------------------------------------------------------------------------------- 1 | package Hello; 2 | use strict; 3 | use warnings; 4 | use parent qw/Amon2/; 5 | our $VERSION='6.13'; 6 | 7 | use Amon2::Config::Simple; 8 | sub load_config { Amon2::Config::Simple->load(shift) } 9 | 10 | use Hello::DB; 11 | 12 | sub db { 13 | my ($self) = @_; 14 | $self->{db} //= do { 15 | my $conf = $self->config->{'DBIx::Skinny'} or die "missing configuration for 'DBIx::Skinny'"; 16 | Hello::DB->new($conf); 17 | }; 18 | } 19 | 20 | 21 | 1; 22 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/ConfigLoader.pm: -------------------------------------------------------------------------------- 1 | package Hello::ConfigLoader; 2 | use strict; 3 | use warnings; 4 | use parent 'Amon2::ConfigLoader'; 5 | 1; 6 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/DB.pm: -------------------------------------------------------------------------------- 1 | package Hello::DB; 2 | use DBIx::Skinny; 3 | 1; 4 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/DB/Schema.pm: -------------------------------------------------------------------------------- 1 | # THIS FILE IS AUTOGENERATED BY DBIx::Skinny::Schema::Loader 0.17, DO NOT EDIT DIRECTLY. 2 | 3 | package Hello::DB::Schema; 4 | use DBIx::Skinny::Schema; 5 | 6 | install_table entry => schema { 7 | pk qw/entry_id/; 8 | columns qw/entry_id body/; 9 | }; 10 | 11 | 1; -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/Web.pm: -------------------------------------------------------------------------------- 1 | package Hello::Web; 2 | use strict; 3 | use warnings; 4 | use parent qw/Hello Amon2::Web/; 5 | 6 | # load all controller classes 7 | use Module::Find (); 8 | Module::Find::useall("Hello::Web::C"); 9 | 10 | # custom classes 11 | use Hello::Web::Request; 12 | use Hello::Web::Response; 13 | sub create_request { Hello::Web::Request->new($_[1]) } 14 | sub create_response { shift; Hello::Web::Response->new(@_) } 15 | 16 | # dispatcher 17 | use Hello::Web::Dispatcher; 18 | sub dispatch { 19 | return Hello::Web::Dispatcher->dispatch($_[0]) or die "response is not generated"; 20 | } 21 | 22 | # setup view class 23 | use Tiffany::Text::Xslate; 24 | { 25 | my $view_conf = __PACKAGE__->config->{'Text::Xslate'} || die "missing configuration for Text::Xslate"; 26 | my $view = Tiffany::Text::Xslate->new(+{ 27 | 'syntax' => 'TTerse', 28 | 'module' => [ 'Text::Xslate::Bridge::Star' ], 29 | 'function' => { 30 | c => sub { Amon2->context() }, 31 | uri_with => sub { Amon2->context()->req->uri_with(@_) }, 32 | uri_for => sub { Amon2->context()->uri_for(@_) }, 33 | }, 34 | %$view_conf 35 | }); 36 | sub create_view { $view } 37 | } 38 | 39 | # load plugins 40 | # __PACKAGE__->load_plugins('Web::FillInFormLite'); 41 | # __PACKAGE__->load_plugins('Web::NoCache'); 42 | 43 | 1; 44 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/Web/C/Root.pm: -------------------------------------------------------------------------------- 1 | package Hello::Web::C::Root; 2 | use strict; 3 | use warnings; 4 | 5 | sub index { 6 | my ($class, $c) = @_; 7 | my @entries = $c->db->search( 8 | entry => {}, {limit => 10, offset => 0, order_by => {'entry_id' => 'DESC'}} 9 | ); 10 | return $c->render( 11 | "index.tt" => { 12 | entries => \@entries, 13 | } 14 | ); 15 | } 16 | 17 | sub post { 18 | my ($class, $c) = @_; 19 | if (my $body = $c->req->param('body')) { 20 | $c->db->insert( 21 | entry => { 22 | body => $body, 23 | }, 24 | ); 25 | } 26 | return $c->redirect('/'); 27 | } 28 | 29 | 1; 30 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/Web/Dispatcher.pm: -------------------------------------------------------------------------------- 1 | package Hello::Web::Dispatcher; 2 | use strict; 3 | use warnings; 4 | 5 | use Amon2::Web::Dispatcher::RouterSimple; 6 | 7 | connect '/' => 'Root#index'; 8 | connect '/post' => 'Root#post'; 9 | 10 | 11 | 1; 12 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/Web/Request.pm: -------------------------------------------------------------------------------- 1 | package Hello::Web::Request; 2 | use strict; 3 | use parent qw/Amon2::Web::Request/; 4 | 1; 5 | -------------------------------------------------------------------------------- /eg/Hello/lib/Hello/Web/Response.pm: -------------------------------------------------------------------------------- 1 | package Hello::Web::Response; 2 | use strict; 3 | use parent qw/Amon2::Web::Response/; 4 | 1; 5 | -------------------------------------------------------------------------------- /eg/Hello/script/make_schema.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use FindBin; 4 | use File::Spec; 5 | use lib File::Spec->catdir($FindBin::Bin, '..', 'lib'); 6 | use lib File::Spec->catdir($FindBin::Bin, '..', 'extlib', 'lib', 'perl5'); 7 | use Hello; 8 | use DBIx::Skinny::Schema::Loader qw/make_schema_at/; 9 | use FindBin; 10 | 11 | my $c = Hello->bootstrap; 12 | my $conf = $c->config->{'DBIx::Skinny'}; 13 | 14 | my $schema = make_schema_at( 'Hello::DB::Schema', {}, $conf ); 15 | my $dest = File::Spec->catfile($FindBin::Bin, '..', 'lib', 'Hello', 'DB', 'Schema.pm'); 16 | open my $fh, '>', $dest or die "cannot open file '$dest': $!"; 17 | print {$fh} $schema; 18 | close $fh; 19 | -------------------------------------------------------------------------------- /eg/Hello/sql/sqlite.sql: -------------------------------------------------------------------------------- 1 | drop table if exists entry; 2 | CREATE TABLE `entry` ( 3 | `entry_id` integer NOT NULL primary key, 4 | `body` text 5 | ); 6 | -------------------------------------------------------------------------------- /eg/Hello/t/01_root.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Plack::Test; 4 | use Plack::Util; 5 | use Test::More; 6 | 7 | my $app = Plack::Util::load_psgi 'Hello.psgi'; 8 | test_psgi 9 | app => $app, 10 | client => sub { 11 | my $cb = shift; 12 | my $req = HTTP::Request->new(GET => 'http://localhost/'); 13 | my $res = $cb->($req); 14 | is $res->code, 200; 15 | diag $res->content if $res->code != 200; 16 | }; 17 | 18 | done_testing; 19 | -------------------------------------------------------------------------------- /eg/Hello/t/02_mech.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Plack::Test; 4 | use Plack::Util; 5 | use Test::More; 6 | use Test::Requires 'Test::WWW::Mechanize::PSGI'; 7 | 8 | my $app = Plack::Util::load_psgi 'Hello.psgi'; 9 | 10 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app); 11 | $mech->get_ok('/'); 12 | 13 | done_testing; 14 | -------------------------------------------------------------------------------- /eg/Hello/tmpl/include/footer.tt: -------------------------------------------------------------------------------- 1 | 2 |
5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /eg/Hello/tmpl/include/header.tt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Hello 6 | 7 | 8 | 9 | 10 | 11 |
12 | 15 |
16 | -------------------------------------------------------------------------------- /eg/Hello/tmpl/index.tt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 |
6 | 7 | 8 |
9 |
    10 | [% FOR entry IN entries %] 11 |
  • [% entry.entry_id %]. [% entry.body %]
    • 12 | [% END %] 13 |
14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /eg/Hello/xt/01_podspell.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval q{ use Test::Spelling }; 3 | plan skip_all => "Test::Spelling is not installed." if $@; 4 | add_stopwords(map { split /[\s\:\-]/ } ); 5 | $ENV{LANG} = 'C'; 6 | all_pod_files_spelling_ok('lib'); 7 | __DATA__ 8 | Hello 9 | Tokuhiro Matsuno 10 | Test::TCP 11 | tokuhirom 12 | AAJKLFJEF 13 | GMAIL 14 | COM 15 | Tatsuhiko 16 | Miyagawa 17 | Kazuhiro 18 | Osawa 19 | lestrrat 20 | typester 21 | cho45 22 | charsbar 23 | coji 24 | clouder 25 | gunyarakun 26 | hio_d 27 | hirose31 28 | ikebe 29 | kan 30 | kazeburo 31 | daisuke 32 | maki 33 | TODO 34 | kazuhooku 35 | FAQ 36 | Amon2 37 | DBI 38 | PSGI 39 | URL 40 | XS 41 | env 42 | .pm 43 | -------------------------------------------------------------------------------- /eg/Hello/xt/02_perlcritic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | eval q{ use Test::Perl::Critic -profile => 'xt/perlcriticrc' }; 4 | plan skip_all => "Test::Perl::Critic is not installed." if $@; 5 | all_critic_ok('lib'); 6 | -------------------------------------------------------------------------------- /eg/Hello/xt/03_pod.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval "use Test::Pod 1.00"; 3 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 4 | all_pod_files_ok(); 5 | -------------------------------------------------------------------------------- /eg/Hello/xt/perlcriticrc: -------------------------------------------------------------------------------- 1 | [TestingAndDebugging::ProhibitNoStrict] 2 | allow=refs 3 | [-Subroutines::ProhibitSubroutinePrototypes] 4 | [TestingAndDebugging::RequireUseStrict] 5 | equivalent_modules = Mouse Mouse::Role Moose Amon2 Amon2::Web Amon2::Web::C Amon2::V::MT::Context Amon2::Web::Dispatcher Amon2::V::MT Amon2::Config DBIx::Skinny DBIx::Skinny::Schema Amon2::Web::Dispatcher::HTTPxDispatcher Any::Moose Amon2::Web::Dispatcher::RouterSimple DBIx::Skinny DBIx::Skinny::Schema Amon2::Web::Dispatcher::Lite common::sense 6 | [-Subroutines::ProhibitExplicitReturnUndef] 7 | -------------------------------------------------------------------------------- /eg/LongPoll/.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | inc/ 3 | MANIFEST 4 | *.bak 5 | *.old 6 | nytprof.out 7 | nytprof/ 8 | *.db 9 | blib/ 10 | pm_to_blib 11 | META.json 12 | META.yml 13 | MYMETA.json 14 | MYMETA.yml 15 | -------------------------------------------------------------------------------- /eg/LongPoll/Makefile.PL: -------------------------------------------------------------------------------- 1 | use ExtUtils::MakeMaker; 2 | 3 | WriteMakefile( 4 | NAME => 'LongPoll', 5 | AUTHOR => 'Some Person ', 6 | VERSION_FROM => 'app.psgi', 7 | PREREQ_PM => { 8 | 'Amon2' => '3.50', 9 | 'Amon2::Lite' => '0.08', 10 | 'Text::Xslate' => '1.5006', 11 | 'Tatsumaki' => 0, 12 | }, 13 | MIN_PERL_VERSION => '5.008001', 14 | (-d 'xt' and $ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING}) ? ( 15 | test => { 16 | TESTS => 't/*.t xt/*.t', 17 | }, 18 | ) : (), 19 | ); 20 | -------------------------------------------------------------------------------- /eg/LongPoll/chat.psgi: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use utf8; 4 | use Amon2::Lite; 5 | use Digest::MD5 (); 6 | use Tatsumaki::MessageQueue; 7 | use Amon2::Web::Response::Callback; 8 | 9 | get '/' => sub { 10 | my $c = shift; 11 | return $c->render('index.tt'); 12 | }; 13 | 14 | my $mq = Tatsumaki::MessageQueue->instance('chat'); 15 | 16 | any '/post' => sub { 17 | my $c = shift; 18 | $mq->publish( 19 | { 20 | type => 'message', 21 | message => scalar($c->req->param('message')), 22 | } 23 | ); 24 | return $c->render_json({ok => 1}); 25 | }; 26 | 27 | any '/poll' => sub { 28 | my ($c) = @_; 29 | 30 | my $client_id = $c->req->param('client_id') 31 | or die; 32 | return $c->streaming_json(sub { 33 | my $writer = shift; 34 | 35 | $mq->poll_once($client_id, sub { 36 | $writer->write_json(\@_); 37 | $writer->close; 38 | }); 39 | }); 40 | }; 41 | 42 | # load plugins 43 | __PACKAGE__->load_plugin('Web::JSON'); 44 | __PACKAGE__->load_plugin('Web::Streaming'); 45 | __PACKAGE__->enable_middleware('AccessLog'); 46 | __PACKAGE__->enable_middleware('Lint'); 47 | 48 | __PACKAGE__->to_app(handle_static => 1); 49 | 50 | __DATA__ 51 | 52 | @@ index.tt 53 | 54 | 55 | 56 | 57 | WS 58 | 59 | 60 | 61 | 62 | 63 | 64 |
65 |

WS

66 |
67 |
68 | 69 | 70 |
71 | 

 72 |         

 73 |         
 74 |     

 75 |     
100 | 
101 | 
102 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/.gitignore:
--------------------------------------------------------------------------------
1 | Makefile
2 | inc/
3 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/DeepNamespace.psgi:
--------------------------------------------------------------------------------
1 | use DeepNamespace;
2 | use DeepNamespace::Web::User;
3 | DeepNamespace::Web::User->to_app();
4 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/Makefile.PL:
--------------------------------------------------------------------------------
1 | use inc::Module::Install;
2 | all_from "lib/DeepNamespace.pm";
3 | 
4 | tests 't/*.t t/*/*.t t/*/*/*.t';
5 | requires 'Amon2';
6 | 
7 | WriteAll;
8 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace.pm:
--------------------------------------------------------------------------------
 1 | package DeepNamespace;
 2 | use parent qw/Amon2/;
 3 | sub load_config {
 4 |     +{
 5 |         "Text::MicroTemplate::Extended" => {
 6 |             include_path => ['tmpl'],
 7 |         }
 8 |     }
 9 | }
10 | 
11 | 1;
12 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/Config.pm:
--------------------------------------------------------------------------------
1 | package DeepNamespace::Config;
2 | use Amon2::Config;
3 | 1;
4 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/V/MT.pm:
--------------------------------------------------------------------------------
1 | package DeepNamespace::V::MT;
2 | use Amon2::V::MT -base;
3 | 1;
4 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/V/MT/Context.pm:
--------------------------------------------------------------------------------
1 | package DeepNamespace::V::MT::Context;
2 | use Amon2::V::MT::Context;
3 | 1;
4 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/Web/Admin.pm:
--------------------------------------------------------------------------------
1 | package DeepNamespace::Web::Admin;
2 | use parent qw/Amon2::Web/;
3 | __PACKAGE__->setup(
4 |     view_class => 'Text::MicroTemplate::Extended',
5 |     base_name => 'DeepNamespace',
6 | );
7 | 1;
8 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/Web/Admin/C/Root.pm:
--------------------------------------------------------------------------------
 1 | package DeepNamespace::Web::Admin::C::Root;
 2 | use strict;
 3 | use warnings;
 4 | 
 5 | sub index {
 6 |     my ($class, $c) = @_;
 7 |     $c->render("index");
 8 | }
 9 | 
10 | 1;
11 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/Web/Admin/Dispatcher.pm:
--------------------------------------------------------------------------------
 1 | package DeepNamespace::Web::Admin::Dispatcher;
 2 | use strict;
 3 | 
 4 | sub dispatch {
 5 |     my ($class, $c) = @_;
 6 |     if ($c->request->path_info eq '/') {
 7 |         return DeepNamespace::Web::Admin::C::Root->index($c);
 8 |     } else {
 9 |         return $c->res_404();
10 |     }
11 | }
12 | 
13 | 1;
14 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/Web/User.pm:
--------------------------------------------------------------------------------
 1 | package DeepNamespace::Web::User;
 2 | use strict;
 3 | use parent qw/DeepNamespace Amon2::Web/;
 4 | use Tiffany;
 5 | use DeepNamespace::Web::User::Dispatcher;
 6 | use Module::Find;
 7 | useall 'DeepNamespace::Web::User::C';
 8 | sub create_view {
 9 |     my $conf = __PACKAGE__->config->{'Text::MicroTemplate::Extended'} || die;
10 |     Tiffany->load( 'Text::MicroTemplate::Extended', $conf);
11 | }
12 | sub dispatch { DeepNamespace::Web::User::Dispatcher->dispatch(shift) }
13 | 1;
14 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/Web/User/C/Root.pm:
--------------------------------------------------------------------------------
 1 | package DeepNamespace::Web::User::C::Root;
 2 | use strict;
 3 | use warnings;
 4 | 
 5 | sub index {
 6 |     my ($class, $c) = @_;
 7 |     $c->render("index");
 8 | }
 9 | 
10 | 1;
11 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/lib/DeepNamespace/Web/User/Dispatcher.pm:
--------------------------------------------------------------------------------
 1 | package DeepNamespace::Web::User::Dispatcher;
 2 | use strict;
 3 | 
 4 | sub dispatch {
 5 |     my ($class, $c) = @_;
 6 |     if ($c->request->path_info eq '/') {
 7 |         return DeepNamespace::Web::User::C::Root->index($c);
 8 |     } else {
 9 |         return $c->res_404();
10 |     }
11 | }
12 | 
13 | 1;
14 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/t/01_root.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Plack::Test;
 4 | use Plack::Util;
 5 | use Test::More;
 6 | 
 7 | my $app = Plack::Util::load_psgi 'DeepNamespace.psgi';
 8 | test_psgi
 9 |     app => $app,
10 |     client => sub {
11 |         my $cb = shift;
12 |         my $req = HTTP::Request->new(GET => 'http://localhost/');
13 |         my $res = $cb->($req);
14 |         is $res->code, 200;
15 |         diag $res->content if $res->code != 200;
16 |     };
17 | 
18 | done_testing;
19 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/tmpl/base.mt:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 | <? block title => 'Amon2' ?>
 5 | 
 6 | 
 7 |  'body here' ?>
 8 | 
 9 | 
10 | 


--------------------------------------------------------------------------------
/eg/apps/DeepNamespace/tmpl/index.mt:
--------------------------------------------------------------------------------
1 | ? extends 'base';
2 | ? block title => 'amon page';
3 | ? block content => sub { 'hello, Amon2 world!' };
4 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/.gitignore:
--------------------------------------------------------------------------------
1 | Makefile
2 | inc/
3 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/Extended.psgi:
--------------------------------------------------------------------------------
1 | use Extended;
2 | use Extended::Web;
3 | 
4 | Extended::Web->to_app();
5 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/Makefile.PL:
--------------------------------------------------------------------------------
1 | use inc::Module::Install;
2 | all_from "lib/Extended.pm";
3 | 
4 | tests 't/*.t t/*/*.t t/*/*/*.t';
5 | requires 'Amon2';
6 | 
7 | WriteAll;
8 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/lib/Extended.pm:
--------------------------------------------------------------------------------
 1 | package Extended;
 2 | use strict;
 3 | use warnings;
 4 | use parent qw/Amon2/;
 5 | use Extended::V::MT::Context;
 6 | 
 7 | sub load_config {
 8 |     +{
 9 |         'Log::Dispatch'                 => +{},
10 |         'Text::MicroTemplate::Extended' => {
11 |             include_path => './tmpl/',
12 |             package_name => 'Extended::V::MT::Context',
13 |         }
14 |     };
15 | }
16 | 
17 | __PACKAGE__->load_plugin('LogDispatch');
18 | 
19 | 1;
20 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/lib/Extended/V/MT/Context.pm:
--------------------------------------------------------------------------------
1 | package Extended::V::MT::Context;
2 | use Amon2::Declare;
3 | 1;
4 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/lib/Extended/Web.pm:
--------------------------------------------------------------------------------
 1 | package Extended::Web;
 2 | use strict;
 3 | use warnings;
 4 | use parent qw/Extended Amon2::Web/;
 5 | 
 6 | use Extended::Web::C::Root;
 7 | 
 8 | use Extended::Web::Request;
 9 | sub create_request  { Extended::Web::Request->new($_[1]) }
10 | 
11 | use Extended::Web::Dispatcher;
12 | sub dispatch {
13 |     my $ret = Extended::Web::Dispatcher->dispatch( $_[0] );
14 |     die "response is not generated" unless $ret;
15 |     return $ret;
16 | }
17 | 
18 | # setup view class
19 | use Tiffany::Text::MicroTemplate::Extended;
20 | {
21 |     my $view_conf = __PACKAGE__->config->{'Text::MicroTemplate::Extended'};
22 |     my $view      = Tiffany::Text::MicroTemplate::Extended->new($view_conf);
23 |     sub create_view { $view }
24 | }
25 | 
26 | __PACKAGE__->load_plugins(
27 |     'Web::HTTPSession' => {
28 |         state => 'Cookie',
29 |         store => 'OnMemory',
30 |     },
31 |     'Web::MobileAgent'
32 | );
33 | 
34 | 1;
35 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/lib/Extended/Web/C/Root.pm:
--------------------------------------------------------------------------------
 1 | package Extended::Web::C::Root;
 2 | use strict;
 3 | use warnings;
 4 | 
 5 | sub index {
 6 |     my ($class, $c) = @_;
 7 |     $c->render("index", $c);
 8 | }
 9 | 
10 | sub die {
11 |     die "OKAY";
12 | }
13 | 
14 | sub session {
15 |     my ($class, $c) = @_;
16 | 
17 |     my $test = $c->session->get('test');
18 |     if ($test) {
19 |         my $res = $c->create_response(200, [], ["hello, $test"]);
20 |         $c->session->set(test => $test + 1);
21 |         return $res;
22 |     } else {
23 |         $c->session->set(test => 1);
24 |         return $c->create_response(200, [], ["first time"]);
25 |     }
26 | }
27 | 
28 | 1;
29 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/lib/Extended/Web/Dispatcher.pm:
--------------------------------------------------------------------------------
 1 | package Extended::Web::Dispatcher;
 2 | use strict;
 3 | use warnings;
 4 | use Amon2::Web::Dispatcher::RouterSimple;
 5 | 
 6 | connect '/'        => 'Root#index';
 7 | connect '/die'     => 'Root#die';
 8 | connect '/session' => 'Root#session';
 9 | 
10 | 1;
11 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/lib/Extended/Web/Request.pm:
--------------------------------------------------------------------------------
1 | package Extended::Web::Request;
2 | use strict;
3 | use warnings;
4 | use base qw/Amon2::Web::Request/;
5 | 
6 | 1;
7 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/t/01_root.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Plack::Test;
 4 | use Plack::Util;
 5 | use Test::More;
 6 | 
 7 | my $app = Plack::Util::load_psgi 'Extended.psgi';
 8 | test_psgi
 9 |     app => $app,
10 |     client => sub {
11 |         my $cb = shift;
12 |         my $req = HTTP::Request->new(GET => 'http://localhost/', [
13 |             'User-Agent' => 'DoCoMo/1.0/P502i/c10',
14 |         ]);
15 |         my $res = $cb->($req);
16 |         is $res->code, 200;
17 |         like $res->content, qr/DoCoMo world!/;
18 |     };
19 | 
20 | done_testing;
21 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/t/02_die.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Plack::Test;
 4 | use Plack::Util;
 5 | use Test::More;
 6 | use Plack::Middleware::StackTrace;
 7 | 
 8 | my $app = Plack::Util::load_psgi 'Extended.psgi';
 9 | test_psgi
10 |     app => Plack::Middleware::StackTrace->wrap($app),
11 |     client => sub {
12 |         my $cb = shift;
13 |         my $req = HTTP::Request->new(GET => 'http://localhost/die');
14 |         my $res = do {
15 |             local *STDERR;
16 |             open *STDERR, '>', \my $out or die $!;
17 |             $cb->($req);
18 |         };
19 |         is $res->code, 500;
20 |         like $res->content, qr/OKAY/;
21 |         return;
22 |     };
23 | 
24 | done_testing;
25 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/t/03_session.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Plack::Test;
 4 | use Plack::Util;
 5 | use Test::More;
 6 | use Test::Requires 'Test::WWW::Mechanize::PSGI';
 7 | use Extended::Web;
 8 | 
 9 | my $app = Extended::Web->to_app();
10 | 
11 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
12 | $mech->get_ok('/session');
13 | $mech->content_contains('first time');
14 | $mech->get_ok('/session');
15 | $mech->content_contains('hello, 1');
16 | $mech->get_ok('/session');
17 | $mech->content_contains('hello, 2');
18 | 
19 | done_testing;
20 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/tmpl/base.mt:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 | <? block title => 'Amon2' ?>
 5 | 
 6 | 
 7 |  'body here' ?>
 8 | 
 9 | 
10 | 


--------------------------------------------------------------------------------
/eg/apps/Extended/tmpl/index.mt:
--------------------------------------------------------------------------------
1 | ? my $c = shift;
2 | ? extends 'base';
3 | ? block title => 'amon page';
4 | ? block content => sub {
5 | hello, mobile_agent->carrier_longname ?> world!
6 | ? };
7 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/SampleApp.psgi:
--------------------------------------------------------------------------------
1 | use SampleApp;
2 | SampleApp->to_app();
3 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/lib/SampleApp.pm:
--------------------------------------------------------------------------------
1 | package SampleApp;
2 | use Amon2 (
3 |   view_class => 'Text::MicroTemplate::File',
4 | );
5 | 1;
6 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/lib/SampleApp/Config.pm:
--------------------------------------------------------------------------------
1 | package SampleApp::Config;
2 | use Amon2::Config;
3 | 1;
4 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/lib/SampleApp/V/MT/Context.pm:
--------------------------------------------------------------------------------
1 | package SampleApp::V::MT::Context;
2 | use Amon2::V::MT::Context;
3 | 1;
4 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/lib/SampleApp/Web/C/Root.pm:
--------------------------------------------------------------------------------
 1 | package SampleApp::Web::C::Root;
 2 | use strict;
 3 | use warnings;
 4 | 
 5 | sub index {
 6 |     my ($class, $c) =@_;
 7 |     $c->render("index.mt");
 8 | }
 9 | 
10 | 1;
11 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/lib/SampleApp/Web/Dispatcher.pm:
--------------------------------------------------------------------------------
 1 | package SampleApp::Web::Dispatcher;
 2 | use Amon2::Web::Dispatcher;
 3 | 
 4 | sub dispatch {
 5 |     my ($class, $c) = @_;
 6 |     if ($c->request->path_info eq '/') {
 7 |         return call("Root", 'index');
 8 |     } else {
 9 |         return res_404();
10 |     }
11 | }
12 | 
13 | 1;
14 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/tmpl/base.mt:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 |   
 4 |     <? block title => 'Amon2' ?>
 5 |   
 6 |   
 7 |      'body here' ?>
 8 |   
 9 | 
10 | 


--------------------------------------------------------------------------------
/eg/apps/SampleApp/tmpl/index.mt:
--------------------------------------------------------------------------------
1 | ? extends 'base.mt';
2 | ? block title => 'amon page';
3 | ? block content => sub { 'hello, Amon2 world!' };
4 | 


--------------------------------------------------------------------------------
/eg/realtime-chat/chat.psgi:
--------------------------------------------------------------------------------
  1 | use strict;
  2 | use warnings;
  3 | use utf8;
  4 | use Amon2::Lite;
  5 | use Digest::MD5 ();
  6 | 
  7 | print "PID: $$\n";
  8 | 
  9 | get '/' => sub {
 10 |     my $c = shift;
 11 |     return $c->render('index.tt');
 12 | };
 13 | 
 14 | my $clients = {};
 15 | 
 16 | any '/echo2' => sub {
 17 |     my ($c) = @_;
 18 |     my $id = Digest::SHA1::sha1_hex(rand() . $$ . {} . time);
 19 | 
 20 |     $c->websocket(sub {
 21 |         my $ws = shift;
 22 |         $clients->{$id} = $ws;
 23 | 
 24 |         $ws->on_receive_message(sub {
 25 |             my ($c, $message) = @_;
 26 |             for (keys %$clients) {
 27 |                 $clients->{$_}->send_message(
 28 |                     "MSG: $message"
 29 |                 );
 30 |             }
 31 |         });
 32 |         $ws->on_eof(sub {
 33 |             my ($c) = @_;
 34 |             delete $clients->{$id};
 35 |         });
 36 |         $ws->on_error(sub {
 37 |             my ($c) = @_;
 38 |             delete $clients->{$id};
 39 |         });
 40 |     });
 41 | };
 42 | 
 43 | # load plugins
 44 | __PACKAGE__->load_plugin('Web::WebSocket');
 45 | __PACKAGE__->enable_middleware('AccessLog');
 46 | __PACKAGE__->enable_middleware('Lint');
 47 | 
 48 | __PACKAGE__->to_app(handle_static => 1);
 49 | 
 50 | __DATA__
 51 | 
 52 | @@ index.tt
 53 | 
 54 | 
 55 | 
 56 |     
 57 |     WS
 58 |     
 59 |     
 60 |     
 61 | 
 62 | 
 63 |     

 64 |         
WS

 65 |         

 66 |             

 67 |                 
 68 |                 
 69 |             

 70 |             

 71 |         

 72 |         
 73 |     

 74 |     
102 | 
103 | 
104 | 


--------------------------------------------------------------------------------
/lib/Amon2/Config/Simple.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Config::Simple;
 2 | use strict;
 3 | use warnings;
 4 | use File::Spec;
 5 | use Carp ();
 6 | 
 7 | sub load {
 8 |     my ($class, $c) = (shift, shift);
 9 |     my %conf = @_ == 1 ? %{$_[0]} : @_;
10 | 
11 |     my $env = $conf{environment} || $c->mode_name || 'development';
12 |     my $fname = File::Spec->catfile($c->base_dir, 'config', "${env}.pl");
13 |     my $config = do $fname;
14 |     Carp::croak("$fname: $@") if $@;
15 |     Carp::croak("$fname: $!") unless defined $config;
16 |     unless ( ref($config) eq 'HASH' ) {
17 |         Carp::croak("$fname does not return HashRef.");
18 |     }
19 |     return $config;
20 | }
21 | 
22 | 1;
23 | __END__
24 | 
25 | =encoding utf-8
26 | 
27 | =head1 NAME
28 | 
29 | Amon2::Config::Simple - Default configuration file loader
30 | 
31 | =head1 SYNOPSIS
32 | 
33 |     package MyApp2;
34 |     # do "config/@{{ $c->mode_name ]}.pl"
35 |     use Amon2::Config::Simple;
36 |     sub load_config { Amon2::Config::Simple->load(shift) }
37 | 
38 | =head1 DESCRIPTION
39 | 
40 | This is a default configuration file loader for L.
41 | 
42 | This module loads the configuration by C<< do >> function. Yes, it's just plain perl code structure.
43 | 
44 | Amon2 using configuration file in C<< "config/@{[ $c->mode_name ]}.pl" >>.
45 | 
46 | =head1 HOW DO YOU USE YOUR OWN ENVIRONMENT VARIABLE FOR DETECTING CONFIGURATION FILE?
47 | 
48 | If you want to use C<< config/$ENV{RUN_MODE}.pl >> for the configuration file, you can write code as following:
49 | 
50 |     package MyApp;
51 |     use Amon2::Config::Simple;
52 |     sub load_config { Amon2::Config::Simple->load(shift, +{ environment => $ENV{RUN_MODE} } ) }
53 | 
54 | 


--------------------------------------------------------------------------------
/lib/Amon2/ContextGuard.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::ContextGuard;
 2 | # THIS IS INTERNAL CLASS.
 3 | # DO NOT USE THIS CLASS DIRECTLY.
 4 | use strict;
 5 | use warnings;
 6 | use utf8;
 7 | 
 8 | sub new {
 9 |     my ($class, $context, $dst) = @_;
10 |     my $orig = $$dst;
11 |     $$dst = $context;
12 |     bless [$orig, $dst], $class;
13 | }
14 | 
15 | sub DESTROY {
16 |     my $self = shift;
17 | 
18 |     # paranoia: guard against cyclic reference
19 |     delete ${$self->[1]}->{$_} for keys %{${$self->[1]}};
20 | 
21 |     ${$self->[1]} = $self->[0];
22 | }
23 | 
24 | 1;
25 | 
26 | 


--------------------------------------------------------------------------------
/lib/Amon2/Declare.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Declare;
 2 | use strict;
 3 | use warnings;
 4 | use base 'Exporter';
 5 | our @EXPORT = qw/c/;
 6 | 
 7 | *c = *Amon2::context;
 8 | 
 9 | 1;
10 | __END__
11 | 
12 | =encoding utf-8
13 | 
14 | =head1 NAME
15 | 
16 | Amon2::Declare - Amon2 Declare Class
17 | 
18 | =head1 SYNOPSIS
19 | 
20 |     use Amon2::Declare;
21 | 
22 |     c();
23 | 
24 | =head1 DESCRIPTION
25 | 
26 | =head1 FUNCTIONS
27 | 
28 | =over 4
29 | 
30 | =item c()
31 | 
32 | Get the context object. This is shortcut for C<< Amon2->context() >> method.
33 | 
34 | =back
35 | 
36 | =head1 SEE ALSO
37 | 
38 | L
39 | 
40 | =cut
41 | 
42 | 


--------------------------------------------------------------------------------
/lib/Amon2/Plugin/Web/FillInFormLite.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Plugin::Web::FillInFormLite;
 2 | use strict;
 3 | use warnings;
 4 | use Amon2::Util;
 5 | use HTML::FillInForm::Lite;
 6 | 
 7 | sub init {
 8 |     my ($class, $c, $conf) = @_;
 9 | 
10 |     Amon2::Util::add_method(ref $c || $c, 'fillin_form', \&_fillin_form2);
11 |     Amon2::Util::add_method(ref $c->create_response(), 'fillin_form', \&_fillin_form);
12 | }
13 | 
14 | sub _fillin_form2 {
15 |     my ($self, @stuff) = @_;
16 |     $self->add_trigger(
17 |         'HTML_FILTER' => sub {
18 |             my ($c, $html) = @_;
19 |             return HTML::FillInForm::Lite->fill(\$html, @stuff);
20 |         },
21 |     );
22 | }
23 | 
24 | 
25 | sub _fillin_form {
26 |     my ($self, @stuff) = @_;
27 |     Carp::cluck("\$res->fillin_form() was deprecated. Use \$c->fillin_form(\$stuff) instead.");
28 | 
29 |     my $html = $self->body();
30 |     my $output = HTML::FillInForm::Lite->fill(\$html, @stuff);
31 |     $self->body($output);
32 |     $self->header('Content-Length' => length($output)) if $self->header('Content-Length');
33 |     return $self;
34 | }
35 | 
36 | 1;
37 | __END__
38 | 
39 | =encoding utf-8
40 | 
41 | =head1 NAME
42 | 
43 | Amon2::Plugin::Web::FillInFormLite - HTML::FillInForm::Lite
44 | 
45 | =head1 SYNOPSIS
46 | 
47 |     use Amon2::Lite;
48 | 
49 |     __PACKAGE__->load_plugins(qw/Web::FillInFormLite/);
50 | 
51 |     post '/edit' => sub {
52 |         my $c = shift;
53 |         unless (is_valid()) {
54 |             $c->fillin_form($c->req);
55 |             return $c->render('edit.html');
56 |         }
57 |         $c->dbh->update($c->req());
58 |         return $c->redirect('/finished');
59 |     };
60 | 
61 | =head1 DESCRIPTION
62 | 
63 | HTML::FillInForm::Lite version of L
64 | 
65 | =head1 SEE ALSO
66 | 
67 | L, L
68 | 
69 | =cut
70 | 
71 | 


--------------------------------------------------------------------------------
/lib/Amon2/Plugin/Web/NoCache.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Plugin::Web::NoCache;
 2 | use strict;
 3 | use warnings;
 4 | 
 5 | sub init {
 6 |     my ($class, $c, $conf) = @_;
 7 | 
 8 |     $c->add_trigger(
 9 |         AFTER_DISPATCH => sub {
10 |             my ($self, $res) = @_;
11 |             $res->header( 'Pragma'        => 'no-cache' );
12 |             $res->header( 'Cache-Control' => 'no-cache' );
13 |         },
14 |     );
15 | }
16 | 
17 | 1;
18 | __END__
19 | 
20 | =encoding utf-8
21 | 
22 | =head1 NAME
23 | 
24 | Amon2::Plugin::Web::NoCache - NoCache(DEPRECATED)
25 | 
26 | =head1 SYNOPSIS
27 | 
28 |     use Amon2::Lite;
29 | 
30 |     __PACKAGE__->load_plugins('Web::NoCache');
31 | 
32 | =head1 DESCRIPTION
33 | 
34 | This plugin adds following headers by AFTER_DISPATCH hook.
35 | 
36 |     Pragma: no-cache
37 |     Cache-Control: no-cache
38 | 
39 | This is very useful if your application don't want to cache by client side.
40 | 
41 | =head1 AUTHOR
42 | 
43 | Tokuhiro Matsuno
44 | 
45 | =head1 SEE ALSO
46 | 
47 | L
48 | 
49 | 


--------------------------------------------------------------------------------
/lib/Amon2/Plugin/Web/PlackSession.pm:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | 
 5 | package Amon2::Plugin::Web::PlackSession;
 6 | use Plack::Session;
 7 | 
 8 | sub init {
 9 |     my ($class, $context_class, $conf) = @_;
10 | 
11 |     no strict 'refs';
12 |     *{"${context_class}::session"} = sub {
13 |         Plack::Session->new($_[0]->request->env)
14 |     };
15 | }
16 | 
17 | 1;
18 | __END__
19 | 
20 | =head1 NAME
21 | 
22 | Amon2::Plugin::Web::PlackSession - (DEPRECATED)
23 | 
24 | =head1 DESCRIPTION
25 | 
26 | This module was deprecated.
27 | 
28 | Amon2 3.00+ provides C<< $c->session >> natively.
29 | 
30 | =head1 SEE ALSO
31 | 
32 | L
33 | 
34 | 


--------------------------------------------------------------------------------
/lib/Amon2/Plugin/Web/Streaming.pm:
--------------------------------------------------------------------------------
  1 | package Amon2::Plugin::Web::Streaming;
  2 | use strict;
  3 | use warnings;
  4 | use utf8;
  5 | 
  6 | use Amon2::Util;
  7 | use Amon2::Web::Response::Callback;
  8 | 
  9 | sub init {
 10 |     my ($class, $c, $conf) = @_;
 11 | 
 12 |     Amon2::Util::add_method(ref $c || $c, 'streaming', \&_streaming);
 13 |     Amon2::Util::add_method(ref $c || $c, 'streaming_json', \&_streaming_json);
 14 | }
 15 | 
 16 | sub _streaming {
 17 |     my ($self, $code) = @_;
 18 |     
 19 |     return Amon2::Web::Response::Callback->new(
 20 |         code => sub {
 21 |             $code->(@_);
 22 |         }
 23 |     );
 24 | }
 25 | 
 26 | sub _streaming_json {
 27 |     my ($self, $code) = @_;
 28 | 
 29 |     return Amon2::Web::Response::Callback->new(
 30 |         code => sub {
 31 |             my $respond = shift;
 32 |             my $writer = $respond->([200, ['Content-Type' => 'application/json;charset=utf-8']]);
 33 | 
 34 |             my $longpoll_ctx = Amon2::Plugin::Web::Streaming::Writer->new(
 35 |                 $self,
 36 |                 $writer
 37 |             );
 38 |             $code->($longpoll_ctx);
 39 |         }
 40 |     );
 41 | }
 42 | 
 43 | package Amon2::Plugin::Web::Streaming::Writer;
 44 | 
 45 | sub new {
 46 |     my ($class, $c, $writer) = @_;
 47 |     bless {ctx => $c, writer => $writer}, $class;
 48 | }
 49 | 
 50 | sub write_json {
 51 |     my ($self, $data) = @_;
 52 |     my $json = $self->{ctx}->render_json($data)->content;
 53 |     $self->{writer}->write($json);
 54 | }
 55 | 
 56 | sub close {
 57 |     my ($self) = @_;
 58 |     $self->{writer}->close();
 59 | }
 60 | 
 61 | 1;
 62 | __END__
 63 | 
 64 | =head1 NAME
 65 | 
 66 | Amon2::Plugin::Web::Streaming - streaming support for Amon2
 67 | 
 68 | =head1 SYNOPSIS
 69 | 
 70 |     use Amon2::Lite;
 71 | 
 72 |     __PACKAGE__->load_plugin(qw/Web::Streaming/);
 73 | 
 74 |     any '/poll' => sub {
 75 |         my $c = shift;
 76 |         return $c->streaming(sub {
 77 |             my $respond = shift;
 78 |             ...;
 79 |             $respond->write([200, [], ['OK']]);
 80 |         });
 81 |     };
 82 | 
 83 |     any '/poll_json' => sub {
 84 |         my $c = shift;
 85 |         return $c->streaming_json(sub {
 86 |             my $writer = shift;
 87 |             ...;
 88 |             $writer->write_json(+{ });
 89 |             $writer->close;
 90 |         });
 91 |     };
 92 | 
 93 | 
 94 | =head1 DESCRIPTION
 95 | 
 96 | This is an Amon2 plugin to support streaming.
 97 | 
 98 | You MUST use the HTTP server supporting psgi.streaming.
 99 | 
100 | =head1 EXPORTED METHODS
101 | 
102 | =over 4
103 | 
104 | =item $c->streaming($code);
105 | 
106 | You can return delayed response for PSGI spec.
107 | 
108 | Argument for $code is C<< $respond >>. It's same as a argument for PSGI callback.
109 | 
110 | =item $c->streaming_json($code);
111 | 
112 | It's a short hand utility to publish streaming JSON.
113 | 
114 | The argument is instance of Amon2::Plugin::Web::Streaming::Writer.
115 | 
116 | =back
117 | 
118 | =head1 Amon2::Plugin::Streaming::Writer METHODS
119 | 
120 | =over 4
121 | 
122 | =item new
123 | 
124 | Do not create the instance directly.
125 | 
126 | =item $writer->write_json($data)
127 | 
128 | Write a $data as JSON for the socket.
129 | 
130 | =item $writer->close()
131 | 
132 | Close the socket.
133 | 
134 | =back
135 | 
136 | 
137 | =head1 SEE ALSO
138 | 
139 | L
140 | 
141 | 


--------------------------------------------------------------------------------
/lib/Amon2/Plugin/Web/WebSocket.pm:
--------------------------------------------------------------------------------
  1 | package Amon2::Plugin::Web::WebSocket;
  2 | use strict;
  3 | use warnings;
  4 | use utf8;
  5 | 
  6 | use Amon2::Util;
  7 | 
  8 | use AnyEvent::Handle;
  9 | use Amon2::Web::WebSocket;
 10 | use Amon2::Web::Response::Callback;
 11 | use Protocol::WebSocket 0.00906;
 12 | use Protocol::WebSocket::Frame;
 13 | use Protocol::WebSocket::Handshake::Server;
 14 | 
 15 | sub init {
 16 |     my ($class, $c, $conf) = @_;
 17 | 
 18 |     Amon2::Util::add_method(ref $c || $c, 'websocket', \&_websocket);
 19 | }
 20 | 
 21 | sub _websocket {
 22 |     my ($c, $code) = @_;
 23 | 
 24 |     my $fh = $c->req->env->{'psgix.io'}
 25 |         or return $c->create_response( 500, [], [] );
 26 |     my $ws = Amon2::Web::WebSocket->new();
 27 |     my $hs = Protocol::WebSocket::Handshake::Server->new_from_psgi(
 28 |         $c->req->env );
 29 |     $hs->parse($fh)
 30 |         or return $c->create_response( 400, [], [ $hs->error ] );
 31 |     my @messages;
 32 |     $ws->{send_message} = sub {
 33 |         my $message = shift;
 34 |         push @messages, $message;
 35 |     };
 36 |     $code->( $ws );
 37 |     my $res = Amon2::Web::Response::Callback->new(
 38 |         code => sub {
 39 |             my $respond = shift;
 40 |             eval {
 41 |                 my $h = AnyEvent::Handle->new( fh => $fh );
 42 |                 $ws->{send_message} = sub {
 43 |                     my $message = shift;
 44 |                     $message = Protocol::WebSocket::Frame->new($message)
 45 |                         ->to_bytes;
 46 |                     $h->push_write($message);
 47 |                 };
 48 |                 my $frame = Protocol::WebSocket::Frame->new();
 49 |                 $h->push_write( $hs->to_string );
 50 |                 $ws->send_message($_) for @messages;
 51 |                 $h->on_read(
 52 |                     sub {
 53 |                         $frame->append( $_[0]->rbuf );
 54 |                         while ( my $message = $frame->next ) {
 55 |                             $ws->call_receive_message( $c, $message );
 56 |                         }
 57 |                     }
 58 |                 );
 59 |                 $h->on_error(
 60 |                     sub {
 61 |                         $ws->call_error($c);
 62 |                     }
 63 |                 );
 64 |                 $h->on_eof(
 65 |                     sub {
 66 |                         $ws->call_eof($c);
 67 |                         close $fh;
 68 |                     }
 69 |                 );
 70 |             };
 71 |             if ($@) {
 72 |                 warn $@;
 73 |                 die "Cannot process websocket";
 74 |             }
 75 |         },
 76 |     );
 77 |     return $res;
 78 | }
 79 | 
 80 | 1;
 81 | __END__
 82 | 
 83 | =head1 NAME
 84 | 
 85 | Amon2::Plugin::Web::WebSocket - [EXPERIMENTAL]WebSocket plugin for Amon2
 86 | 
 87 | =head1 SYNOPSIS
 88 | 
 89 |     use Amon2::Lite;
 90 | 
 91 |     any '/echo' => sub {
 92 |         my ($c) = @_;
 93 |         return $c->websocket(sub {
 94 |             my $ws = shift;
 95 |             $ws->on_receive_message(sub {
 96 |                 my ($c, $message) = @_;
 97 |                 $ws->send_message("YAY: " . $message);
 98 |             });
 99 |         });
100 |     };
101 | 
102 | =head1 DESCRIPTION
103 | 
104 | This plugin provides WebSocket feature for Amon2.
105 | 
106 | You can use WebSocket very easily with Amon2.
107 | 
108 | This plugin depended on AnyEvent. You can use this module on L only.
109 | 
110 | =head1 METHODS
111 | 
112 | =over 4
113 | 
114 | =item C<< $c->websocket(\&callback); >>
115 | 
116 | =back
117 | 
118 | =head1 SEE ALSO
119 | 
120 | L, L
121 | 
122 | 


--------------------------------------------------------------------------------
/lib/Amon2/Setup/Asset/MicroDispatcherJS.pm:
--------------------------------------------------------------------------------
 1 | # This file is generated by author/assets.pl. Do not edit manually.
 2 | package Amon2::Setup::Asset::MicroDispatcherJS;
 3 | use strict;
 4 | use warnings;
 5 | 
 6 | sub tags {
 7 |     <<',,,';
 8 |     
 9 | ,,,
10 | }
11 | 
12 | sub files {
13 |     return {
14 |   'js/micro_dispatcher.js' => '// micro_dispatcher.js - (C) tokuhirom, MIT License.
15 | (function() {
16 |     var namedParam    = /:([\\w\\d]+)/g;
17 |     var splatParam    = /\\*([\\w\\d]+)/g;
18 |     var escapeRegExp  = /[\\-\\[\\]{}()+?.,\\\\\\^$|#\\s]/g;
19 | 
20 |     // http://perfectionkills.com/instanceof-considered-harmful-or-how-to-write-a-robust-isarray/
21 |     var toString = Object.prototype.toString;
22 |     function isRegExp(obj) {
23 |         return toString.call(obj)==\'[object RegExp]\';
24 |     }
25 | 
26 |     function Dispatcher() {
27 |         this.routes = [];
28 |     }
29 |     Dispatcher.prototype = {
30 |         register: function(route, callback) {
31 |             if (!isRegExp(route)) {
32 |                 route = this._compileRoute(route);
33 |             }
34 |             this.routes.push([route, callback]);
35 |         },
36 |         dispatch: function (path) {
37 |             var routes = this.routes;
38 |             for (var i=0, l=routes.length; i
  9 | ,,,
 10 | }
 11 | 
 12 | sub files {
 13 |     return {
 14 |   'js/micro-location.js' => '/**
 15 |  * https://github.com/cho45/micro-location.js
 16 |  * (c) cho45 http://cho45.github.com/mit-license
 17 |  */
 18 | // immutable object, should not assign a value to properties
 19 | function Location () { this.init.apply(this, arguments) }
 20 | Location.prototype = {
 21 | 	init : function (protocol, host, hostname, port, pathname, search, hash) {
 22 | 		this.protocol  = protocol;
 23 | 		this.host      = host;
 24 | 		this.hostname  = hostname;
 25 | 		this.port      = port || "";
 26 | 		this.pathname  = pathname || "";
 27 | 		this.search    = search || "";
 28 | 		this.hash      = hash || "";
 29 | 		if (protocol) {
 30 | 			with (this) this.href = protocol + \'//\' + host + pathname + search + hash;
 31 | 		} else
 32 | 		if (host) {
 33 | 			with (this) this.href = \'//\' + host + pathname + search + hash;
 34 | 		} else {
 35 | 			with (this) this.href = pathname + search + hash;
 36 | 		}
 37 | 	},
 38 | 
 39 | 	params : function (name) {
 40 | 		if (!this._params) {
 41 | 			var params = {};
 42 | 
 43 | 			var pairs = this.search.substring(1).split(/[;&]/);
 44 | 			for (var i = 0, len = pairs.length; i < len; i++) {
 45 | 				if (!pairs[i]) continue;
 46 | 				var pair = pairs[i].split(/=/);
 47 | 				var key  = decodeURIComponent(pair[0].replace(/\\+/g, \'%20\'));
 48 | 				var val  = decodeURIComponent(pair[1].replace(/\\+/g, \'%20\'));
 49 | 
 50 | 				if (!params[key]) params[key] = [];
 51 | 				params[key].push(val);
 52 | 			}
 53 | 
 54 | 			this._params = params;
 55 | 		}
 56 | 
 57 | 		switch (typeof name) {
 58 | 			case "undefined": return this._params;
 59 | 			case "object"   : return this.build(name);
 60 | 		}
 61 | 		return this._params[name] ? this._params[name][0] : null;
 62 | 	},
 63 | 
 64 | 	build : function (params) {
 65 | 		if (!params) params = this._params;
 66 | 
 67 | 		var ret = new Location();
 68 | 		var _search = this.search;
 69 | 		if (params) {
 70 | 			var search = [];
 71 | 			for (var key in params) if (params.hasOwnProperty(key)) {
 72 | 				var val = params[key];
 73 | 				switch (typeof val) {
 74 | 					case "object":
 75 | 						for (var i = 0, len = val.length; i < len; i++) {
 76 | 							search.push(encodeURIComponent(key) + \'=\' + encodeURIComponent(val[i]));
 77 | 						}
 78 | 						break;
 79 | 					default:
 80 | 						search.push(encodeURIComponent(key) + \'=\' + encodeURIComponent(val));
 81 | 				}
 82 | 			}
 83 | 			_search = \'?\' + search.join(\'&\');
 84 | 		}
 85 | 
 86 | 		with (this) ret.init.apply(ret, [
 87 | 			protocol,
 88 | 			host,
 89 | 			hostname,
 90 | 			port,
 91 | 			pathname,
 92 | 			_search,
 93 | 			hash
 94 | 		]);
 95 | 		return ret;
 96 | 	}
 97 | };
 98 | Location.regexp = new RegExp(\'^(?:(https?:)//(([^:/]+)(:[^/]+)?))?([^#?]*)(\\\\?[^#]*)?(#.*)?$\');
 99 | Location.parse = function (string) {
100 | 	var matched = String(string).match(this.regexp);
101 | 	var ret = new Location();
102 | 	ret.init.apply(ret, matched.slice(1));
103 | 	return ret;
104 | };
105 | 
106 | (function (root, factory) {
107 | 	if (typeof module === "object" && module.exports) {
108 | 		module.exports = { 
109 | 			Location: factory()
110 | 		};
111 | 	} else if (typeof define === \'function\' && define.amd) {
112 | 		define([], function () {
113 | 			return {
114 | 				Location: factory()
115 | 			}
116 | 		});
117 | 	} else {
118 | 		root.Location = factory();
119 | 	}
120 | }(this, function () {
121 | 	return Location;
122 | }));
123 | '
124 | }
125 | ;
126 | }
127 | 
128 | 1;
129 | 


--------------------------------------------------------------------------------
/lib/Amon2/Setup/Asset/MicroTemplateJS.pm:
--------------------------------------------------------------------------------
 1 | # This file is generated by author/assets.pl. Do not edit manually.
 2 | package Amon2::Setup::Asset::MicroTemplateJS;
 3 | use strict;
 4 | use warnings;
 5 | 
 6 | sub tags {
 7 |     <<',,,';
 8 |     
 9 | ,,,
10 | }
11 | 
12 | sub files {
13 |     return {
14 |   'js/micro_template.js' => '// Simple JavaScript Templating
15 | // John Resig - http://ejohn.org/ - MIT Licensed
16 | (function(){
17 |     var cache = {};
18 |     this.tmpl = function tmpl(str, data){
19 |         // Figure out if we\'re getting a template, or if we need to
20 |         // load the template - and be sure to cache the result.
21 |         var fn = !/\\W/.test(str) ?
22 |             cache[str] = cache[str] ||
23 |             tmpl(document.getElementById(str).innerHTML) :
24 | 
25 |         // Generate a reusable function that will serve as a template
26 |         // generator (and which will be cached).
27 |         new Function("obj",
28 |                      "var p=[];" +
29 | 
30 |                      // Introduce the data as local variables using with(){}
31 |                      "with(obj){p.push(\'" +
32 | 
33 |                      // Convert the template into pure JavaScript
34 |                      str
35 |                      .replace(/[\\r\\t\\n]/g, " ")
36 |                      .split("<%").join("\\t")
37 |                      .replace(/(^|%>)[^\\t]*?(\\t|$)/g, function(){return arguments[0].split("\'").join("\\\\\'");})
38 |                      .replace(/\\t==(.*?)%>/g,"\',$1,\'")
39 |                      .replace(/\\t=(.*?)%>/g, "\',(($1)+\'\').replace(/&/g,\'&\').replace(//g,\'>\').replace(/\\"/g,\'"\').replace(/\\\'/g,\''\'),\'")
40 |                      .split("\\t").join("\');")
41 |                      .split("%>").join("p.push(\'")
42 |                      + "\');}return p.join(\'\');");
43 | 
44 |         // Provide some basic currying to the user
45 |         return data ? fn( data ) : fn;
46 |     };
47 | })();
48 | '
49 | }
50 | ;
51 | }
52 | 
53 | 1;
54 | 


--------------------------------------------------------------------------------
/lib/Amon2/Setup/Asset/XSRFTokenJS.pm:
--------------------------------------------------------------------------------
 1 | # This file is generated by author/assets.pl. Do not edit manually.
 2 | package Amon2::Setup::Asset::XSRFTokenJS;
 3 | use strict;
 4 | use warnings;
 5 | 
 6 | sub tags {
 7 |     <<',,,';
 8 |     
 9 | ,,,
10 | }
11 | 
12 | sub files {
13 |     return {
14 |   'js/xsrf-token.js' => '(function (document, $) {
15 |     $(function () {
16 |         "use strict";
17 | 
18 |         var xsrf_token = getXSRFToken();
19 |         $("form").each(function () {
20 |             var form = $(this);
21 |             var method = form.attr(\'method\');
22 |             if (method === \'get\' || method === \'GET\') {
23 |                 return;
24 |             }
25 | 
26 |             var input = $(document.createElement(\'input\'));
27 |             input.attr(\'type\',  \'hidden\');
28 |             input.attr(\'name\',  \'XSRF-TOKEN\');
29 |             input.attr(\'value\',  xsrf_token);
30 |             form.prepend(input);
31 |         });
32 | 
33 |         function getXSRFToken() {
34 |             var cookies = document.cookie.split(/\\s*;\\s*/);
35 |             for (var i=0,l=cookies.length; i 'all';
  3 | use utf8;
  4 | 
  5 | package Amon2::Setup::Flavor::Basic;
  6 | use parent qw(Amon2::Setup::Flavor);
  7 | 
  8 | our $VERSION = '6.16';
  9 | 
 10 | sub run {
 11 |     my $self = shift;
 12 | 
 13 |     # write code.
 14 |     $self->render_file( "tmpl/index.tx",          "Basic/tmpl/index.tx" );
 15 |     $self->render_file( "tmpl/include/layout.tx", "Basic/tmpl/include/layout.tx" );
 16 |     $self->render_file( "tmpl/include/pager.tx",  "Basic/tmpl/include/pager.tx" );
 17 | 
 18 |     $self->render_file( 'lib/<>.pm',                   'Basic/lib/__PATH__.pm' );
 19 |     $self->render_file( 'lib/<>/Web.pm',               'Basic/lib/__PATH__/Web.pm' );
 20 |     $self->render_file( 'lib/<>/Web/Plugin/Session.pm','Basic/lib/__PATH__/Web/Plugin/Session.pm' );
 21 |     $self->render_file( 'lib/<>/Web/Dispatcher.pm',    'Basic/lib/__PATH__/Web/Dispatcher.pm' );
 22 |     $self->render_file( 'lib/<>/Web/View.pm',          'Minimum/lib/__PATH__/Web/View.pm' );
 23 |     $self->render_file( 'lib/<>/Web/ViewFunctions.pm', 'Minimum/lib/__PATH__/Web/ViewFunctions.pm' );
 24 |     $self->render_file( 'lib/<>/DB.pm',                'Basic/lib/__PATH__/DB.pm' );
 25 |     $self->render_file( 'lib/<>/DB/Schema.pm',         'Basic/lib/__PATH__/DB/Schema.pm' );
 26 |     $self->render_file( 'lib/<>/DB/Row.pm',            'Basic/lib/__PATH__/DB/Row.pm' );
 27 | 
 28 |     $self->render_file( $self->psgi_file, 'Basic/script/server.pl' );
 29 |     $self->render_file( 'Build.PL', 'Minimum/Build.PL' );
 30 |     $self->render_file( 'minil.toml', 'Minimum/minil.toml' );
 31 |     $self->render_file( 'builder/MyBuilder.pm', 'Minimum/builder/MyBuilder.pm' );
 32 | 
 33 | 
 34 |     $self->create_cpanfile({
 35 |         'HTML::FillInForm::Lite'          => '1.11',
 36 |         'Time::Piece'                     => '1.20',
 37 |         'Plack::Middleware::ReverseProxy' => '0.09',
 38 |         'JSON'                            => '2.50',
 39 |         'Teng'                            => '0.18',
 40 |         'DBD::SQLite'                     => '1.33',
 41 |         'Test::WWW::Mechanize::PSGI'      => 0,
 42 |         'Router::Boom'                    => '0.06',
 43 |         'HTTP::Session2'                  => '1.03',
 44 |         'Crypt::CBC'                      => '0',
 45 |         'Crypt::Rijndael'                 => '0',
 46 |     });
 47 | 
 48 |     # static files
 49 |     $self->write_assets();
 50 | 
 51 |     $self->write_file("static/img/.gitignore", '');
 52 |     $self->write_file("static/robots.txt", '');
 53 | 
 54 |     $self->render_file("static/js/main.js",   "Basic/static/js/main.js");
 55 |     $self->render_file("static/css/main.css", "Basic/static/css/main.css");
 56 | 
 57 |     $self->render_file('db/.gitignore', 'Basic/db/dot.gitignore');
 58 | 
 59 |     # configuration files
 60 |     for my $env (qw(development production test)) {
 61 |         $self->render_file( "config/${env}.pl", 'Basic/config/__ENV__.pl', { env => $env } );
 62 |     }
 63 | 
 64 |     $self->render_file( 'sql/mysql.sql',  'Basic/sql/mysql.sql' );
 65 |     $self->render_file( 'sql/sqlite.sql', 'Basic/sql/sqlite.sql' );
 66 | 
 67 |     $self->render_file( 't/Util.pm',      'Basic/t/Util.pm' );
 68 |     $self->render_file( 't/00_compile.t',     'Basic/t/00_compile.t' );
 69 |     $self->render_file( 't/01_root.t',    'Minimum/t/01_root.t', {
 70 |         psgi_file => $self->psgi_file,
 71 |     });
 72 |     $self->render_file( 't/02_mech.t',    'Minimum/t/02_mech.t', {
 73 |         psgi_file => $self->psgi_file,
 74 |     });
 75 |     $self->render_file( 't/03_assets.t',      'Basic/t/03_assets.t', {
 76 |         psgi_file => $self->psgi_file,
 77 |     });
 78 |     $self->render_file( 't/06_jshint.t',      'Basic/t/06_jshint.t' );
 79 |     $self->render_file( 'xt/01_pod.t',    'Minimum/xt/01_pod.t' );
 80 |     $self->render_file( 'xt/02_perlcritic.t', 'Basic/xt/02_perlcritic.t' );
 81 | 
 82 |     $self->render_file('.gitignore', 'Basic/dot.gitignore');
 83 |     $self->render_file('.proverc', 'Basic/dot.proverc');
 84 | 
 85 |     {
 86 |         my %status = (
 87 |             '503' => 'Service Unavailable',
 88 |             '502' => 'Bad Gateway',
 89 |             '500' => 'Internal Server Error',
 90 |             '504' => 'Gateway Timeout',
 91 |             '404' => 'Not Found'
 92 |         );
 93 |         while (my ($status, $status_message) = each %status) {
 94 |             $self->render_file(
 95 |                 "static/$status.html",
 96 |                 "Basic/static/__STATUS__.html",
 97 |                 { status => $status, status_message => $status_message }
 98 |             );
 99 |         }
100 |     }
101 | }
102 | 
103 | sub psgi_file {
104 |     my $self = shift;
105 |     'script/' . lc($self->{dist}) . '-server';
106 | }
107 | 
108 | sub show_banner {
109 |     my $self = shift;
110 | 
111 |     printf <<'...', $self->psgi_file;
112 | --------------------------------------------------------------
113 | 
114 | Setup script was done! You are ready to run the skelton.
115 | 
116 | You need to install the dependencies by:
117 | 
118 |     > carton install
119 | 
120 | And then, run your application server:
121 | 
122 |     > carton exec perl -Ilib %s
123 | 
124 | --------------------------------------------------------------
125 | ...
126 | }
127 | 
128 | 1;
129 | __END__
130 | 
131 | =head1 NAME
132 | 
133 | Amon2::Setup::Flavor::Basic - Basic flavor selected by default
134 | 
135 | =head1 SYNOPSIS
136 | 
137 |     % amon2-setup.pl --flavor=Basic MyApp
138 | 
139 | =head1 DESCRIPTION
140 | 
141 | This is a basic flavor for Amon2. This is the default flavor.
142 | 
143 | =head1 AUTHOR
144 | 
145 | Tokuhiro Matsuno
146 | 


--------------------------------------------------------------------------------
/lib/Amon2/Setup/Flavor/Minimum.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Setup::Flavor::Minimum;
 2 | use strict;
 3 | use warnings FATAL => 'all';
 4 | use utf8;
 5 | use parent qw(Amon2::Setup::Flavor);
 6 | 
 7 | our $VERSION = '6.16';
 8 | 
 9 | sub run {
10 |     my ($self) = @_;
11 | 
12 |     $self->render_file('lib/<>.pm',                   'Minimum/lib/__PATH__.pm');
13 |     $self->render_file("tmpl/index.tx",                     'Minimum/tmpl/index.tx');
14 |     $self->render_file($self->psgi_file,                    'Minimum/script/server.pl');
15 |     $self->render_file('lib/<>/Web.pm',               'Minimum/lib/__PATH__/Web.pm');
16 |     $self->render_file('lib/<>/Web/View.pm',          'Minimum/lib/__PATH__/Web/View.pm');
17 |     $self->render_file('lib/<>/Web/ViewFunctions.pm', 'Minimum/lib/__PATH__/Web/ViewFunctions.pm', {
18 |         'context_class' => 'Amon2',
19 |     });
20 |     $self->render_file('Build.PL', 'Minimum/Build.PL');
21 |     $self->render_file('minil.toml', 'Minimum/minil.toml');
22 |     $self->render_file('builder/MyBuilder.pm', 'Minimum/builder/MyBuilder.pm');
23 |     $self->render_file('t/Util.pm', 'Minimum/t/Util.pm');
24 |     $self->render_file('t/00_compile.t', 'Minimum/t/00_compile.t', {
25 |         psgi_file => $self->psgi_file,
26 |     });
27 |     $self->render_file('t/01_root.t', 'Minimum/t/01_root.t', {
28 |         psgi_file => $self->psgi_file,
29 |     });
30 |     $self->render_file('t/02_mech.t', 'Minimum/t/02_mech.t', {
31 |         psgi_file => $self->psgi_file,
32 |     });
33 |     $self->render_file('xt/01_pod.t', 'Minimum/xt/01_pod.t');
34 | 
35 |     $self->create_cpanfile();
36 | }
37 | 
38 | sub psgi_file {
39 |     my $self = shift;
40 |     'script/' . lc($self->{dist}) . '-server';
41 | }
42 | 
43 | sub show_banner {
44 |     my $self = shift;
45 | 
46 |     printf <<'...', $self->psgi_file;
47 | --------------------------------------------------------------
48 | 
49 | Setup script was done! You are ready to run the skelton.
50 | 
51 | You need to install the dependencies by:
52 | 
53 |     > carton install
54 | 
55 | And then, run your application server:
56 | 
57 |     > carton exec perl -Ilib %s
58 | 
59 | --------------------------------------------------------------
60 | ...
61 | }
62 | 
63 | 1;
64 | __END__
65 | 
66 | =head1 NAME
67 | 
68 | Amon2::Setup::Flavor::Minimum - Minimalistic flavor suitable for benchmarking
69 | 
70 | =head1 SYNOPSIS
71 | 
72 |     % amon2-setup.pl --flavor=Minimum MyApp
73 | 
74 | =head1 DESCRIPTION
75 | 
76 | This is a flavor for benchmarking...
77 | 
78 | =head1 AUTHOR
79 | 
80 | Tokuhiro Matsuno
81 | 


--------------------------------------------------------------------------------
/lib/Amon2/Setup/VC/Git.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Setup::VC::Git;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use File::Temp qw(tempfile);
 6 | 
 7 | sub new {
 8 |     bless {}, $_[0];
 9 | }
10 | 
11 | sub do_import {
12 |     my ($self) = @_;
13 | 
14 |     unless ($self->_is_git_available('git')) {
15 |         warn "There is no git command.\n";
16 |         return;
17 |     }
18 | 
19 |     !system("git init") or die $?;
20 |     !system("git add .") or die $?;
21 |     !system(q{git commit -m "initial import"}) or die $?;
22 | }
23 | 
24 | sub _is_git_available {
25 |     my ($self) = @_;
26 | 
27 |     if ($^O eq 'MSWin32') {
28 |         no warnings;
29 |         !system('git --version 2>&1 > NUL');
30 |     } else {
31 |         my $pid = fork();
32 |         die "Cannot fork: $!" if !defined $pid;
33 |         if ($pid) { # parent
34 |             waitpid($pid, 0);
35 |             require POSIX;
36 |             POSIX::WIFEXITED($?) && POSIX::WEXITSTATUS($?)==0 ? 1 : 0;
37 |         } else { # child
38 |             my ($logfh, $logfile) = tempfile(UNLINK => 1);
39 |             open STDOUT, '>', $logfile or die "$!";
40 |             open STDERR, '>&STDOUT' or die "$!";
41 |             no warnings;
42 |             exec('git', '--version');
43 |             exit(9);
44 |         }
45 |     }
46 | }
47 | 
48 | 1;
49 | 
50 | 


--------------------------------------------------------------------------------
/lib/Amon2/Trigger.pm:
--------------------------------------------------------------------------------
  1 | package Amon2::Trigger;
  2 | use strict;
  3 | use warnings;
  4 | use parent qw/Exporter/;
  5 | use Scalar::Util ();
  6 | use mro;
  7 | 
  8 | our @EXPORT = qw/add_trigger call_trigger get_trigger_code/;
  9 | 
 10 | sub add_trigger {
 11 |     my ($class, %args) = @_;
 12 | 
 13 |     if (ref $class) {
 14 |         while (my ($hook, $code) = each %args) {
 15 |             push @{$class->{_trigger}->{$hook}}, $code;
 16 |         }
 17 |     } else {
 18 |         no strict 'refs';
 19 |         while (my ($hook, $code) = each %args) {
 20 |             push @{${"${class}::_trigger"}->{$hook}}, $code;
 21 |         }
 22 |     }
 23 | }
 24 | 
 25 | sub call_trigger {
 26 |     my ($class, $hook, @args) = @_;
 27 |     my @code = $class->get_trigger_code($hook);
 28 |     for my $code (@code) {
 29 |         $code->($class, @args);
 30 |     }
 31 | }
 32 | 
 33 | sub get_trigger_code {
 34 |     my ($class, $hook) = @_;
 35 |     my @code;
 36 |     if (Scalar::Util::blessed($class)) {
 37 |         push @code, @{ $class->{_trigger}->{$hook} || [] };
 38 |         $class = ref $class;
 39 |     }
 40 |     no strict 'refs';
 41 |     my $klass = ref $class || $class;
 42 |     for (@{mro::get_linear_isa($class)}) {
 43 |         push @code, @{${"${_}::_trigger"}->{$hook} || []};
 44 |     }
 45 |     return @code;
 46 | }
 47 | 
 48 | 1;
 49 | __END__
 50 | 
 51 | =head1 NAME
 52 | 
 53 | Amon2::Trigger - Trigger system for Amon2
 54 | 
 55 | =head1 SYNOPSIS
 56 | 
 57 |     package MyClass;
 58 |     use parent qw/Amon2::Trigger/;
 59 | 
 60 |     __PACKAGE__->add_trigger('Foo');
 61 |     __PACKAGE__->call_trigger('Foo');
 62 | 
 63 | =head1 DESCRIPTION
 64 | 
 65 | This is a trigger system for Amon2. You can use this class for your class using trigger system.
 66 | 
 67 | =head1 METHODS
 68 | 
 69 | =over 4
 70 | 
 71 | =item C<< __PACKAGE__->add_trigger($name:Str, \&code:CodeRef) >>
 72 | 
 73 | =item C<< $obj->add_trigger($name:Str, \&code:CodeRef) >>
 74 | 
 75 | You can register the callback function for the class or object.
 76 | 
 77 | When you register callback code on object, the callback is only registered to object, not for class.
 78 | 
 79 | I: Not defined.
 80 | 
 81 | =item C<< __PACKAGE__->call_trigger($name:Str); >>
 82 | 
 83 | =item C<< $obj->call_trigger($name:Str); >>
 84 | 
 85 | This method calls all callback code for $name.
 86 | 
 87 | I: Not defined.
 88 | 
 89 | =item C<< __PACKAGE__->get_trigger_code($name:Str) >>
 90 | 
 91 | =item C<< $obj->get_trigger_code($name:Str) >>
 92 | 
 93 | You can get all of trigger code from the class and ancestors.
 94 | 
 95 | =back
 96 | 
 97 | =head1 FAQ
 98 | 
 99 | =over 4
100 | 
101 | =item WHY DON'T YOU USE L?
102 | 
103 | L does not support get_trigger_code.
104 | 
105 | =back
106 | 


--------------------------------------------------------------------------------
/lib/Amon2/Util.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Util;
 2 | use strict;
 3 | use warnings;
 4 | use base qw/Exporter/;
 5 | use File::Spec;
 6 | use MIME::Base64 ();
 7 | use Digest::SHA ();
 8 | use Time::HiRes;
 9 | use POSIX ();
10 | use Carp ();
11 | 
12 | our @EXPORT_OK = qw/add_method random_string/;
13 | 
14 | sub add_method {
15 |     my ($klass, $method, $code) = @_;
16 |     no strict 'refs';
17 |     *{"${klass}::${method}"} = $code;
18 | }
19 | 
20 | sub base_dir($) {
21 |     my $path = shift;
22 |     $path =~ s!::!/!g;
23 |     if (my $libpath = $INC{"$path.pm"}) {
24 |         $libpath =~ s!\\!/!g; # win32
25 |         $libpath =~ s!(?:blib/)?lib/+$path\.pm$!!;
26 |         File::Spec->rel2abs($libpath || './');
27 |     } else {
28 |         File::Spec->rel2abs('./');
29 |     }
30 | }
31 | 
32 | our $URANDOM_FH;
33 | 
34 | # $URANDOM_FH is undef if there is no /dev/urandom
35 | open $URANDOM_FH, '<:raw', '/dev/urandom'
36 |     or do {
37 |     undef($URANDOM_FH);
38 |     warn "Cannot open /dev/urandom: $!.";
39 | };
40 | 
41 | sub random_string {
42 |     my $len = shift;
43 | 
44 |     # 27 is the sha1_base64() length.
45 |     if ($len < 27) {
46 |         Carp::cluck("Amon2::Util::random_string: Length too short. You should use 27+ bytes for security reason.");
47 |     }
48 | 
49 |     if ($URANDOM_FH) {
50 |         my $src_len = POSIX::ceil($len/3.0*4.0);
51 |         # Generate session id from /dev/urandom.
52 |         my $read = read($URANDOM_FH, my $buf, $src_len);
53 |         if ($read != $src_len) {
54 |             die "Cannot read bytes from /dev/urandom: $!";
55 |         }
56 |         my $result = MIME::Base64::encode_base64($buf, '');
57 |         $result =~ tr|+/=|\-_|d; # make it url safe
58 |         return substr($result, 0, $len);
59 |     } else {
60 |         # It's weaker than above. But it's portable.
61 |         my $out = '';
62 |         while (length($out) < $len) {
63 |             my $sha1 = Digest::SHA::sha1_base64(rand() . $$ . {} . Time::HiRes::time());
64 |             $sha1 =~ tr|+/=|\-_|d; # make it url safe
65 |             $out .= $sha1;
66 |         }
67 |         return substr($out, 0, $len);
68 |     }
69 | }
70 | 
71 | 1;
72 | __END__
73 | 
74 | =head1 DESCRIPTION
75 | 
76 | This is a utility class for Amon2. Do not use this directly.
77 | 


--------------------------------------------------------------------------------
/lib/Amon2/Web/Dispatcher/Lite.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Web::Dispatcher::Lite;
 2 | use strict;
 3 | use warnings;
 4 | use parent 'Amon2::Web';
 5 | use Router::Simple 0.14;
 6 | use Router::Simple::Sinatraish;
 7 | 
 8 | sub import {
 9 |     my $class = shift;
10 |     my $caller = caller(0);
11 | 
12 |     Router::Simple::Sinatraish->export_to_level(1);
13 |     my $router = $caller->router;
14 | 
15 |     no strict 'refs';
16 |     *{"$caller\::dispatch"} = sub {
17 |         my ($klass, $c) = @_;
18 | 
19 |         if (my $p = $router->match($c->request->env)) {
20 |             return $p->{code}->($c, $p);
21 |         } else {
22 |             if ($router->method_not_allowed) {
23 |                 return $c->res_405();
24 |             } else {
25 |                 return $c->res_404();
26 |             }
27 |         }
28 |     };
29 | }
30 | 
31 | 1;
32 | __END__
33 | 
34 | =encoding utf-8
35 | 
36 | =head1 NAME
37 | 
38 | Amon2::Web::Dispatcher::Lite - Sinatra like dispatcher for Amon2
39 | 
40 | =head1 SYNOPSIS
41 | 
42 |     package MyApp::Web;
43 |     use Amon2::Web::Dispatcher::Lite;
44 | 
45 |     get '/' => sub {
46 |         render('index.mt');
47 |     };
48 |     get '/hello/:name' => sub {
49 |         my ($c, $args) = @_;
50 |         render('hello.mt', $args->{name});
51 |     };
52 | 
53 |     1;
54 | 
55 | =head1 DESCRIPTION
56 | 
57 | B
58 | 
59 | B
60 | You need to list this class to your cpanfile.
61 | 
62 | 


--------------------------------------------------------------------------------
/lib/Amon2/Web/Dispatcher/RouterSimple.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Web::Dispatcher::RouterSimple;
 2 | use strict;
 3 | use warnings;
 4 | use Router::Simple 0.03;
 5 | 
 6 | sub import {
 7 |     my $class = shift;
 8 |     my %args = @_;
 9 |     my $caller = caller(0);
10 | 
11 |     my $router = Router::Simple->new();
12 | 
13 |     no strict 'refs';
14 |     # functions
15 |     *{"${caller}::connect"} = sub {
16 |         if (@_ == 2 && !ref $_[1]) {
17 |             my ($path, $dest_str) = @_;
18 |             my ($controller, $action) = split('#', $dest_str);
19 |             my %dest;
20 |             $dest{controller} = $controller;
21 |             $dest{action} = $action if defined $action;
22 |             $router->connect($path, \%dest);
23 |         } else {
24 |             $router->connect(@_);
25 |         }
26 |     };
27 |     *{"${caller}::submapper"} = sub {
28 |         $router->submapper(@_);
29 |     };
30 |     # class methods
31 |     *{"${caller}::router"} = sub { $router };
32 |     for my $meth (qw/match as_string/) {
33 |         *{"$caller\::${meth}"} = sub {
34 |             my $self = shift;
35 |             $router->$meth(@_)
36 |         };
37 |     }
38 |     *{"$caller\::dispatch"} = \&_dispatch;
39 | }
40 | 
41 | sub _dispatch {
42 |     my ($class, $c) = @_;
43 |     my $req = $c->request;
44 |     if (my $p = $class->match($req->env)) {
45 |         my $action = $p->{action};
46 |         $c->{args} = $p;
47 |         "@{[ ref $c ]}::C::$p->{controller}"->$action($c, $p);
48 |     } else {
49 |         $c->res_404();
50 |     }
51 | }
52 | 
53 | 1;
54 | __END__
55 | 
56 | =encoding utf-8
57 | 
58 | =head1 NAME
59 | 
60 | Amon2::Web::Dispatcher::RouterSimple - Router::Simple binding for Amon2
61 | 
62 | =head1 SYNOPSIS
63 | 
64 |     package MyApp::Web::Dispatcher;
65 |     use Amon2::Web::Dispatcher::RouterSimple;
66 |     connect '/'           => 'Root#index';
67 |     connect '/my/'        => 'My#index';
68 |     connect '/my/:action' => 'My';
69 |     1;
70 | 
71 | =head1 DESCRIPTION
72 | 
73 | L binding for Amon2.
74 | 
75 | B
76 | You need to list this class to your cpanfile.
77 | 
78 | =head1 AUTHOR
79 | 
80 | Tokuhiro Matsuno
81 | 
82 | =head1 SEE ALSO
83 | 
84 | L
85 | 
86 | 


--------------------------------------------------------------------------------
/lib/Amon2/Web/Response.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Web::Response;
 2 | use strict;
 3 | use warnings;
 4 | use parent qw/Plack::Response/;
 5 | 
 6 | 
 7 | 1;
 8 | __END__
 9 | 
10 | =encoding utf-8
11 | 
12 | =head1 NAME
13 | 
14 | Amon2::Web::Response - web response class for Amon2
15 | 
16 | =head1 DESCRIPTION
17 | 
18 | This is response class for Amon2.
19 | 
20 | This class is child class of L.
21 | 
22 | There is no extension for now, but I'm using this class for future plan.
23 | 


--------------------------------------------------------------------------------
/lib/Amon2/Web/Response/Callback.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Web::Response::Callback;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use Carp ();
 6 | use HTTP::Headers ();
 7 | 
 8 | sub new {
 9 |     my $class = shift;
10 |     my %args = @_ == 1 ? %{$_[0]} : @_;
11 |     $args{code} || Carp::croak "Missing mandatory parameter: code";
12 |     bless {
13 |         headers => HTTP::Headers->new,
14 |         %args
15 |     }, $class;
16 | }
17 | sub header {
18 |     my $self = shift;
19 |     $self->headers->header(@_);
20 | }
21 | sub headers { $_[0]->{headers} }
22 | sub finalize {
23 |     my $self = shift;
24 |     delete $self->{headers};
25 | 
26 |     # Defence from HTTP Header Splitting.
27 |     my $code = delete $self->{code};
28 |     return sub {
29 |         my $responder = shift;
30 |         $code->(
31 |             sub {
32 |                 my @copy = @{ $_[0]->[1] };
33 |                 while (my (undef, $val) = splice(@copy, 0, 2)) {
34 |                     if ($val =~ /[\000-\037]/) {
35 |                         die("Response headers MUST NOT contain characters below octal \037\n");
36 |                     }
37 |                 }
38 |                 return $responder->(@_);
39 |             }
40 |         );
41 |     };
42 | }
43 | 
44 | 
45 | 1;
46 | __END__
47 | 
48 | =head1 NAME
49 | 
50 | Amon2::Web::Response::Callback - [EXPERIMENTAL]callback style psgi response for Amon2
51 | 
52 | =head1 SYNOPSIS
53 | 
54 |     use Amon2::Lite;
55 | 
56 |     any '/cb' => sub {
57 |         my $c = shift;
58 |         Amon2::Web::Response::Callback->new(
59 |             code => sub {
60 |                 my $respond = shift;
61 |                 $respond->([200, [], []]);
62 |             }
63 |         );
64 |     };
65 | 
66 | =head1 DESCRIPTION
67 | 
68 | This module provides a response object for delayed response/streaming body.
69 | 
70 | You can embed the AE support, streaming support, etc on Amon2 with this module.
71 | 
72 | =head1 SEE ALSO
73 | 
74 | L
75 | 
76 | 


--------------------------------------------------------------------------------
/lib/Amon2/Web/WebSocket.pm:
--------------------------------------------------------------------------------
 1 | package Amon2::Web::WebSocket;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | 
 6 | sub new {
 7 |     my $class = shift;
 8 |     my %args = @_==1 ? %{$_[0]} : @_;
 9 |     bless {
10 |         %args
11 |     }, $class;
12 | }
13 | 
14 | sub on_receive_message {
15 |     my ( $self, $code ) = @_;
16 |     $self->{on_receive_message} = $code;
17 | }
18 | 
19 | sub on_error {
20 |     my ( $self, $code ) = @_;
21 |     $self->{on_error} = $code;
22 | }
23 | 
24 | sub on_eof {
25 |     my ( $self, $code ) = @_;
26 |     $self->{on_eof} = $code;
27 | }
28 | 
29 | sub call_receive_message {
30 |     my ( $self, $c, $message ) = @_;
31 |     if ( $self->{on_receive_message} ) {
32 |         $self->{on_receive_message}->( $c, $message );
33 |     }
34 | }
35 | 
36 | sub call_error {
37 |     my ( $self, $c ) = @_;
38 |     if ( $self->{on_error} ) {
39 |         $self->{on_error}->($c);
40 |     }
41 | }
42 | 
43 | sub call_eof {
44 |     my ( $self, $c ) = @_;
45 |     if ( $self->{on_eof} ) {
46 |         $self->{on_eof}->($c);
47 |     }
48 | }
49 | 
50 | sub send_message {
51 |     my ( $self, $message ) = @_;
52 |     $self->{send_message}->($message);
53 | }
54 | 
55 | 1;
56 | __END__
57 | 
58 | =head1 NAME
59 | 
60 | Amon2::Web::WebSocket - WebSocket support for Amon2
61 | 
62 | =head1 DESCRIPTION
63 | 
64 | This module is a helper class for WebSocket support for Amon2.
65 | 
66 | see L for concrete usage.
67 | 
68 | =head1 METHODS
69 | 
70 | =over 4
71 | 
72 | =item C<< $ws->on_receive_message(\&code); >>
73 | 
74 | =item C<< $ws->on_eof(\&code); >>
75 | 
76 | =item C<< $ws->on_error(\&code); >>
77 | 
78 | set a callback function on received event.
79 | 
80 | =back
81 | 


--------------------------------------------------------------------------------
/minil.toml:
--------------------------------------------------------------------------------
1 | name="Amon2"
2 | badges = ["travis"]
3 | 


--------------------------------------------------------------------------------
/script/amon2-setup.pl:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/perl
  2 | use strict;
  3 | use warnings;
  4 | use Getopt::Long;
  5 | use Pod::Usage;
  6 | use Amon2::Setup::Flavor::Basic;
  7 | use Amon2::Setup::VC::Git;
  8 | use Cwd ();
  9 | use Plack::Util;
 10 | use File::Find ();
 11 | use File::Spec ();
 12 | 
 13 | my @flavors;
 14 | my $vc = 'Git';
 15 | GetOptions(
 16 |     'help'           => \my $help,
 17 |     'list-flavors|l' => \my $list_flavors,
 18 |     'flavor=s@'      => \@flavors,
 19 |     'vc=s'           => \$vc,
 20 |     'version'        => \my $version,
 21 | ) or pod2usage(0);
 22 | if ($version) {
 23 |     require Amon2;
 24 |     print "Perl: $]\n";
 25 |     print "Amon2: $Amon2::VERSION\n";
 26 |     exit(0);
 27 | }
 28 | list_flavors() if $list_flavors;
 29 | pod2usage(1) if $help;
 30 | push @flavors, 'Basic' if @flavors == 0;
 31 | @flavors = map { split /,/, $_ } @flavors;
 32 | 
 33 | &main;exit;
 34 | 
 35 | sub main {
 36 |     my $module = shift @ARGV or pod2usage(0);
 37 |        $module =~ s!-!::!g;
 38 | 
 39 |     # $module = "Foo::Bar"
 40 |     # $dist   = "Foo-Bar"
 41 |     # $path   = "Foo/Bar"
 42 |     my @pkg  = split /::/, $module;
 43 |     my $dist = join "-", @pkg;
 44 |     my $path = join "/", @pkg;
 45 | 
 46 |     mkdir $dist or die "Cannot mkdir '$dist': $!";
 47 |     chdir $dist or die $!;
 48 | 
 49 |     my @flavor_classes;
 50 |     my @flavor_instances;
 51 |     for my $flavor (@flavors) {
 52 |         my $flavor_class = load_flavor($flavor);
 53 |         push @flavor_classes, $flavor_class;
 54 | 
 55 |         print "-- Running flavor: $flavor --\n";
 56 | 
 57 |         my $cwd = Cwd::getcwd(); # save cwd
 58 |             {
 59 |                 my $flavor = $flavor_class->new(module => $module);
 60 |                    $flavor->run;
 61 |                 push @flavor_instances, $flavor;
 62 |             }
 63 |         chdir($cwd);
 64 |     }
 65 | 
 66 | 	{
 67 | 		$vc = Plack::Util::load_class($vc, 'Amon2::Setup::VC');
 68 | 		$vc = $vc->new();
 69 | 		$vc->do_import();
 70 | 	}
 71 | 
 72 |     for my $flavor_class (@flavor_classes) {
 73 |         if ($flavor_class->can('call_trigger')) {
 74 |             $flavor_class->call_trigger('AFTER_VC');
 75 |         }
 76 |     }
 77 | 
 78 |     for my $flavor (@flavor_instances) {
 79 |         if ($flavor->can('show_banner')) {
 80 |             $flavor->show_banner();
 81 |         }
 82 |     }
 83 | }
 84 | 
 85 | sub load_flavor {
 86 |     my $flavor_name = shift;
 87 | 
 88 |     my $flavor_class = $flavor_name =~ s/^\+// ? $flavor_name : "Amon2::Setup::Flavor::$flavor_name";
 89 |     eval "use $flavor_class; 1" or die "Cannot load $flavor_class: $@";
 90 | 
 91 |     return $flavor_class;
 92 | }
 93 | 
 94 | sub list_flavors {
 95 | 
 96 |     my $prefix = "Amon2::Setup::Flavor";
 97 | 
 98 |     my $dir = File::Spec->catdir(split /::/, $prefix);
 99 | 
100 |     my @results;
101 |     my %seen;
102 |     foreach my $base(map { File::Spec->catdir($_, $dir) } @INC) {
103 |         next unless -d $base;
104 | 
105 |         File::Find::find({
106 |                 wanted => sub {
107 |                     return unless -r;
108 |                     my $name = File::Spec->abs2rel($_, $base);
109 |                     $name =~ s/\.pm$// or return;
110 | 
111 |                     $seen{$name}++ and return;
112 | 
113 |                     push @results, join '::', File::Spec->splitdir($name);
114 |                 },
115 |                 no_chdir => 1,
116 |             }, $base);
117 |     }
118 | 
119 |     for my $moniker (sort @results) {
120 |         my $module = eval {
121 |             Plack::Util::load_class($moniker, $prefix);
122 |         };
123 |         # extract short description
124 |         my $content = do {
125 |             open my $fh, "<", $INC{join("/", split "::", $module).".pm"};
126 |             local $/;
127 |             <$fh>;
128 |         };
129 |         my($description) = $content =~ m{
130 |             ^=head1 \s+ NAME
131 |             \s+
132 |             \Q$module\E \s+ - \s+ ([^\n]+)
133 |         }xms;
134 |         if (defined $description) {
135 |             print $moniker, " - ", $description, "\n";
136 |         }
137 |         else {
138 |             print $moniker, "\n";
139 |         }
140 |     }
141 | 
142 |     exit;
143 | }
144 | 
145 | __END__
146 | 
147 | =head1 NAME
148 | 
149 | amon2-setup.pl - setup script for amon2
150 | 
151 | =head1 SYNOPSIS
152 | 
153 |     % amon2-setup.pl MyApp
154 | 
155 |         --flavor=Basic      basic flavour (default)
156 |         --flavor=Lite       Amon2::Lite flavour (need to install)
157 |         --flavor=Minimum    minimalistic flavour for benchmarking
158 |         --flavor=Standalone CPAN uploadable web application(EXPERIMENTAL)
159 | 
160 |         --vc=Git         setup the git repository (default)
161 | 
162 |         --list-flavors (or -l) Shows the list of flavors installed
163 | 
164 |         --help   Show this help
165 | 
166 | =head1 DESCRIPTION
167 | 
168 | This is a setup script for Amon2.
169 | 
170 | amon2-setup.pl is highly extensible. You can write your own flavor.
171 | 
172 | =head1 HINTS
173 | 
174 | You can specify C<< --flavor >> option multiple times. For example, you can
175 | type like following:
176 | 
177 |     % amon2-setup.pl --flavor=Basic --flavor=Teng MyApp
178 | 
179 |     % amon2-setup.pl --flavor=Teng,Basic MyApp
180 | 
181 | Second flavor can overwrite files generated by first flavor.
182 | 
183 | =head1 AUTHOR
184 | 
185 | Tokuhiro Matsuno
186 | 
187 | =cut
188 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/config/__ENV__.pl:
--------------------------------------------------------------------------------
 1 | use File::Spec;
 2 | use File::Basename qw(dirname);
 3 | my $basedir = File::Spec->rel2abs(File::Spec->catdir(dirname(__FILE__), '..'));
 4 | my $dbpath = File::Spec->catfile($basedir, 'db', '<% $env %>.db');
 5 | +{
 6 |     'DBI' => [
 7 |         "dbi:SQLite:dbname=$dbpath", '', '',
 8 |         +{
 9 |             sqlite_unicode => 1,
10 |         }
11 |     ],
12 | };
13 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/db/dot.gitignore:
--------------------------------------------------------------------------------
1 | *
2 | !.gitignore
3 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/dot.gitignore:
--------------------------------------------------------------------------------
 1 | Makefile
 2 | /inc/
 3 | MANIFEST
 4 | *.bak
 5 | *.old
 6 | nytprof.out
 7 | nytprof/
 8 | *.db
 9 | /blib/
10 | pm_to_blib
11 | META.json
12 | META.yml
13 | MYMETA.json
14 | MYMETA.yml
15 | /Build
16 | /_build/
17 | /local/
18 | /.carton/
19 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/dot.proverc:
--------------------------------------------------------------------------------
1 | -l
2 | -r t
3 | -Mt::Util
4 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/lib/__PATH__.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | our $VERSION='0.01';
 6 | use 5.008001;
 7 | use <% $module %>::DB::Schema;
 8 | use <% $module %>::DB;
 9 | 
10 | use parent qw/Amon2/;
11 | # Enable project local mode.
12 | __PACKAGE__->make_local_context();
13 | 
14 | my $schema = <% $module %>::DB::Schema->instance;
15 | 
16 | sub db {
17 |     my $c = shift;
18 |     if (!exists $c->{db}) {
19 |         my $conf = $c->config->{DBI}
20 |             or die "Missing configuration about DBI";
21 |         $c->{db} = <% $module %>::DB->new(
22 |             schema       => $schema,
23 |             connect_info => [@$conf],
24 |             # I suggest to enable following lines if you are using mysql.
25 |             # on_connect_do => [
26 |             #     'SET SESSION sql_mode=STRICT_TRANS_TABLES;',
27 |             # ],
28 |         );
29 |     }
30 |     $c->{db};
31 | }
32 | 
33 | 1;
34 | __END__
35 | 
36 | =head1 NAME
37 | 
38 | <% $module %> - <% $module %>
39 | 
40 | =head1 DESCRIPTION
41 | 
42 | This is a main context class for <% $module %>
43 | 
44 | =head1 AUTHOR
45 | 
46 | <% $module %> authors.
47 | 
48 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/lib/__PATH__/DB.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::DB;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use parent qw(Teng);
 6 | 
 7 | __PACKAGE__->load_plugin('Count');
 8 | __PACKAGE__->load_plugin('Replace');
 9 | __PACKAGE__->load_plugin('Pager');
10 | 
11 | 1;
12 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/lib/__PATH__/DB/Row.pm:
--------------------------------------------------------------------------------
1 | package <% $module %>::DB::Row;
2 | use strict;
3 | use warnings;
4 | use utf8;
5 | use parent qw(Teng::Row);
6 | 
7 | 1;
8 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/lib/__PATH__/DB/Schema.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::DB::Schema;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | 
 6 | use Teng::Schema::Declare;
 7 | 
 8 | base_row_class '<% $module %>::DB::Row';
 9 | 
10 | table {
11 |     name 'member';
12 |     pk 'id';
13 |     columns qw(id name);
14 | };
15 | 
16 | 1;
17 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/lib/__PATH__/Web.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::Web;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use parent qw/<% $module %> Amon2::Web/;
 6 | use File::Spec;
 7 | 
 8 | # dispatcher
 9 | use <% $module %>::Web::Dispatcher;
10 | sub dispatch {
11 |     return (<% $module %>::Web::Dispatcher->dispatch($_[0]) or die "response is not generated");
12 | }
13 | 
14 | # load plugins
15 | __PACKAGE__->load_plugins(
16 |     'Web::FillInFormLite',
17 |     'Web::JSON',
18 |     '+<% $module %>::Web::Plugin::Session',
19 | );
20 | 
21 | # setup view
22 | use <% $module %>::Web::View;
23 | {
24 |     sub create_view {
25 |         my $view = <% $module %>::Web::View->make_instance(__PACKAGE__);
26 |         no warnings 'redefine';
27 |         *<% $module %>::Web::create_view = sub { $view }; # Class cache.
28 |         $view
29 |     }
30 | }
31 | 
32 | # for your security
33 | __PACKAGE__->add_trigger(
34 |     AFTER_DISPATCH => sub {
35 |         my ( $c, $res ) = @_;
36 | 
37 |         # http://blogs.msdn.com/b/ie/archive/2008/07/02/ie8-security-part-v-comprehensive-protection.aspx
38 |         $res->header( 'X-Content-Type-Options' => 'nosniff' );
39 | 
40 |         # http://blog.mozilla.com/security/2010/09/08/x-frame-options/
41 |         $res->header( 'X-Frame-Options' => 'DENY' );
42 | 
43 |         # Cache control.
44 |         $res->header( 'Cache-Control' => 'private' );
45 |     },
46 | );
47 | 
48 | 1;
49 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/lib/__PATH__/Web/Dispatcher.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::Web::Dispatcher;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use Amon2::Web::Dispatcher::RouterBoom;
 6 | 
 7 | any '/' => sub {
 8 |     my ($c) = @_;
 9 |     my $counter = $c->session->get('counter') || 0;
10 |     $counter++;
11 |     $c->session->set('counter' => $counter);
12 |     return $c->render('index.tx', {
13 |         counter => $counter,
14 |     });
15 | };
16 | 
17 | post '/reset_counter' => sub {
18 |     my $c = shift;
19 |     $c->session->remove('counter');
20 |     return $c->redirect('/');
21 | };
22 | 
23 | post '/account/logout' => sub {
24 |     my ($c) = @_;
25 |     $c->session->expire();
26 |     return $c->redirect('/');
27 | };
28 | 
29 | 1;
30 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/lib/__PATH__/Web/Plugin/Session.pm:
--------------------------------------------------------------------------------
 1 | package <% $package // ($module ~ "::Web::Plugin::Session") %>;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | 
 6 | use Amon2::Util;
 7 | use HTTP::Session2::ClientStore2;
 8 | use Crypt::CBC;
 9 | 
10 | sub init {
11 |     my ($class, $c) = @_;
12 | 
13 |     # Validate XSRF Token.
14 |     $c->add_trigger(
15 |         BEFORE_DISPATCH => sub {
16 |             my ( $c ) = @_;
17 |             if ($c->req->method ne 'GET' && $c->req->method ne 'HEAD') {
18 |                 my $token = $c->req->header('X-XSRF-TOKEN') || $c->req->param('XSRF-TOKEN');
19 |                 unless ($c->session->validate_xsrf_token($token)) {
20 |                     return $c->create_simple_status_page(
21 |                         403, 'XSRF detected.'
22 |                     );
23 |                 }
24 |             }
25 |             return;
26 |         },
27 |     );
28 | 
29 |     Amon2::Util::add_method($c, 'session', \&_session);
30 | 
31 |     # Inject cookie header after dispatching.
32 |     $c->add_trigger(
33 |         AFTER_DISPATCH => sub {
34 |             my ( $c, $res ) = @_;
35 |             if ($c->{session} && $res->can('cookies')) {
36 |                 $c->{session}->finalize_plack_response($res);
37 |             }
38 |             return;
39 |         },
40 |     );
41 | }
42 | 
43 | # $c->session() accessor.
44 | my $cipher = Crypt::CBC->new({
45 |     key => '<% random_string(32) %>',
46 |     cipher => 'Rijndael',
47 | });
48 | sub _session {
49 |     my $self = shift;
50 | 
51 |     if (!exists $self->{session}) {
52 |         $self->{session} = HTTP::Session2::ClientStore2->new(
53 |             env => $self->req->env,
54 |             secret => '<% random_string(32) %>',
55 |             cipher => $cipher,
56 |         );
57 |     }
58 |     return $self->{session};
59 | }
60 | 
61 | 1;
62 | __END__
63 | 
64 | =head1 DESCRIPTION
65 | 
66 | This module manages session for <% $module %>.
67 | 
68 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/script/server.pl:
--------------------------------------------------------------------------------
 1 | %% cascade "Minimum/script/server.pl"
 2 | 
 3 | %% override load_modules -> {
 4 | use <% $module %>::Web;
 5 | use <% $module %>;
 6 | use URI::Escape;
 7 | use File::Path ();
 8 | %% }
 9 | 
10 | %% override app -> {
11 | my $app = builder {
12 |     enable 'Plack::Middleware::Static',
13 |         path => qr{^(?:/static/)},
14 |         root => File::Spec->catdir(dirname(__FILE__), '..');
15 |     enable 'Plack::Middleware::Static',
16 |         path => qr{^(?:/robots\.txt|/favicon\.ico)$},
17 |         root => File::Spec->catdir(dirname(__FILE__), '..', 'static');
18 |     enable 'Plack::Middleware::ReverseProxy';
19 | 
20 |     <% $module %>::Web->to_app();
21 | };
22 | %% }
23 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/sql/mysql.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS member (
2 |     id           INTEGER NOT NULL PRIMARY KEY AUTO_INCREMENT,
3 |     name         VARCHAR(255)
4 | );
5 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/sql/sqlite.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS member (
2 |     id           INTEGER NOT NULL PRIMARY KEY,
3 |     name         VARCHAR(255)
4 | );
5 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/static/__STATUS__.html:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 |     
 4 |         
 5 |         
21 |     
22 |     
23 |         
<% $status %>

24 |         
<% $status_message %>

25 |     
26 | 
27 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/static/css/main.css:
--------------------------------------------------------------------------------
 1 | body {
 2 | }
 3 | 
 4 | footer {
 5 |     text-align: right;
 6 |     padding-right: 10px;
 7 |     padding-top: 2px; }
 8 |     footer a {
 9 |         text-decoration: none;
10 |         color: black;
11 |         font-weight: bold;
12 |     }
13 | 
14 | /* smart phones */
15 | @media screen and (max-device-width: 480px) {
16 | }
17 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/static/js/main.js:
--------------------------------------------------------------------------------
1 | if (typeof(window.console) == "undefined") { console = {}; console.log = console.warn = console.error = function(a) {}; }
2 | 
3 | $(function () {
4 | });
5 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/t/00_compile.t:
--------------------------------------------------------------------------------
1 | <% cascade "Minimum/t/00_compile.t" %>
2 | <% after load_modules -> { %>
3 | use <% $module %>::DB::Schema;
4 | use <% $module %>::Web::Dispatcher;
5 | <% } %>
6 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/t/03_assets.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use t::Util;
 5 | use Plack::Test;
 6 | use Plack::Util;
 7 | use Test::More;
 8 | 
 9 | my $app = Plack::Util::load_psgi '<% $psgi_file // "app.psgi" %>';
10 | test_psgi
11 |     app => $app,
12 |     client => sub {
13 |         my $cb = shift;
14 |         for my $fname (qw(static/bootstrap/css/bootstrap.css robots.txt)) {
15 |             my $req = HTTP::Request->new(GET => "http://localhost/$fname");
16 |             my $res = $cb->($req);
17 |             is($res->code, 200, $fname) or diag $res->content;
18 |         }
19 |     };
20 | 
21 | done_testing;
22 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/t/06_jshint.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'Text::SimpleTable';
 5 | use File::Basename;
 6 | 
 7 | plan skip_all => 'this test requires "jshint" command'
 8 |   if system("jshint --version") != 0;
 9 | 
10 | my @files = (<<% $static_dir // 'static' %>/*/*.js>, <<% $static_dir // 'static' %>/*/*/*.js>, <<% $static_dir // 'static' %>/*/*/*/*.js>);
11 | 
12 | my %WHITE_LIST = map { $_ => 1 } qw(
13 |     bootstrap.js
14 |     bootstrap.min.js
15 |     micro-location.js
16 |     micro_template.js
17 | );
18 | 
19 | my $table = Text::SimpleTable->new( 25, 5 );
20 | 
21 | for my $file (@files) {
22 |     next if $WHITE_LIST{basename($file)};
23 |     next if basename($file) =~ /jquery-[0-9.]+.min.js$/;
24 | 
25 |     my $out = `jshint $file`;
26 |     my $err = 0;
27 |     if ( $out =~ /(\d+) errors?/ ) {
28 |         ( $err ) = ( $1 );
29 |         is($err, 0, $file)
30 |             or note $out;
31 |     }
32 |     else {
33 |         ok(1);
34 |     }
35 |     $table->row( basename($file), $err );
36 | }
37 | 
38 | note $table->draw;
39 | 
40 | done_testing;
41 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/t/Util.pm:
--------------------------------------------------------------------------------
 1 | %% cascade "Minimum/t/Util.pm"
 2 | 
 3 | %% after export -> {
 4 |     slurp
 5 | %% }
 6 | 
 7 | %% after functions -> {
 8 | sub slurp {
 9 |     my $fname = shift;
10 |     open my $fh, '<:encoding(UTF-8)', $fname or die "$fname: $!";
11 |     scalar do { local $/; <$fh> };
12 | }
13 | 
14 | # initialize database
15 | use <% $module %>;
16 | {
17 |     unlink 'db/test.db' if -f 'db/test.db';
18 |     system("sqlite3 db/test.db < sql/sqlite.sql");
19 | }
20 | %% }
21 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/tmpl/include/layout.tx:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 |     
 5 |     <: $title || '<%= $dist %>' :>
 6 |     
 7 |     
 8 |     
 9 |     
10 | <% $tags -%>
11 |     
12 |     
13 |     
16 | 
17 | 
18 |     

19 |         

20 |             

21 |                 <% $dist %>
22 |             

23 |             

24 |                 
30 |             

31 |         

32 |     

33 |     

34 |         

35 |             <: block content -> { } :>
36 |         

37 |         

38 |             Powered by Amon2
39 |         

40 |     

41 | 
42 | 
43 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/tmpl/include/pager.tx:
--------------------------------------------------------------------------------
 1 | : if ($pager) {
 2 |     

 3 |         
    
 4 |             <: if ($pager.previous_page) { :>
 5 |                 
  • 
 6 |             <: } else { :>
 7 |                 
  • 
 8 |             <: } :>
 9 | 
10 |             <: if ($pager.can('pages_in_navigation')) { :>
11 |                 <: # IF Data::Page::Navigation is loaded  :>
12 |                 <: for $pager.pages_in_navigation(5) -> $p { :>
13 |                     
  • class="active"<: } :>><: $p :>
    • 
14 |                 <: } :>
15 |             <: } else { :>
16 |                 
  • <: $pager.current_page() :>
    • 
17 |             <: } :>
18 | 
19 |             <: if ($pager.next_page()) { :>
20 |                 
  • 
21 |             <: } else { :>
22 |                 
  • 
23 |             <: } :>
24 |         

25 |     

26 | : }
27 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/tmpl/index.tx:
--------------------------------------------------------------------------------
 1 | : cascade "include/layout.tx"
 2 | 
 3 | : override content -> {
 4 | 
 5 | 
Hello, Amon2 world!

 6 | 
 7 | 

 8 | 
 9 | 
14 | 

15 |     
Battery Included?

16 | 
17 |     

18 |         

19 |             
 CSS Library

20 |             

21 |                 Current version of Amon2 using twitter's bootstrap.css as a default CSS library.

22 |                 If you want to learn it, please access to getbootstrap.com/
23 |             

24 |         

25 | 
26 |         

27 |             
 JS Library

28 |             

29 |                 jQuery included.
30 |                 
    
31 |                     
  • micro-location.js
    • 
32 |                     
  • micro_template.js
    • 
33 |                     
  • sprintf-0.7-beta1.js
    • 
34 |                     
  • strftime.js
    • 
35 |                 

36 |             

37 |         

38 | 
39 |         

40 |             
 Template Engine

41 |             

42 |                 Amon2 uses Text::Xslate(Kolon) as a primary template engine.

43 |                 But you can use any template engine easily.
44 |             

45 |         

46 |     

47 | 
48 |     

49 |         

50 |             
 O/R Mapper?

51 |             

52 |                 There is no O/R Mapper support. But I recommend use Teng.

53 |                 You can integrate Teng very easily.

54 |                 Refer to this page for more details.
55 |             

56 |         

57 |     

58 | 

59 | 
60 | 

61 | 
62 | 

63 |     
Amon2 is right for you if ...

64 |     

65 |         
    
66 |         
  • You need exceptional performance.
    • 
67 |         
  • You want a framework with a small footprint.
    • 
68 |         
  • You want a framework that requires nearly zero configuration.
    • 
69 |         

70 |     

71 | 

72 | 
73 | 

74 | 
75 | 

76 |     

77 |         
Documents?

78 |         
Complete docs are available on amon.64p.org

79 |         
And there are module specific docs on CPAN

80 |     

81 | 

82 | 
83 | 

84 | 
85 | 
Session counter demo

86 | 
87 | 
You seen this page <: $counter :> times.

88 | 
89 | 

90 |     
91 | 

92 |      
93 | 
94 | : }
95 | 


--------------------------------------------------------------------------------
/share/flavor/Basic/xt/02_perlcritic.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | 
 5 | eval {
 6 |     require Perl::Critic;
 7 |     Perl::Critic->VERSION(1.105);
 8 | 
 9 |     require Test::Perl::Critic;
10 |     Test::Perl::Critic->VERSION(1.02);
11 |     Test::Perl::Critic->import(
12 |         -profile => \(join q{}, )
13 |     );
14 | };
15 | note $@ if $@;
16 | plan skip_all => "Perl::Critic 1.105+ or Test::Perl::Critic 1.02+ is not installed." if $@;
17 | 
18 | all_critic_ok('lib', 'script', 'bin');
19 | 
20 | __END__
21 | 
22 | only=1
23 | 
24 | # -------------------------------------------------------------------------
25 | # Not important.
26 | 
27 | [BuiltinFunctions::ProhibitSleepViaSelect]
28 | [BuiltinFunctions::RequireGlobFunction]
29 | [ClassHierarchies::ProhibitOneArgBless]
30 | 
31 | # -------------------------------------------------------------------------
32 | # Bug detection
33 | [InputOutput::ProhibitBarewordFileHandles]
34 | [Modules::RequireFilenameMatchesPackage]
35 | [Subroutines::ProhibitNestedSubs]
36 | [Subroutines::ProhibitReturnSort]
37 | [TestingAndDebugging::RequireUseStrict]
38 | [Variables::ProhibitConditionalDeclarations]
39 | [Variables::RequireLexicalLoopIterators]
40 | 
41 | [TestingAndDebugging::ProhibitNoStrict]
42 | allow=refs
43 | 
44 | # -------------------------------------------------------------------------
45 | # Security issue detection
46 | [InputOutput::RequireEncodingWithUTF8Layer]
47 | [Modules::ProhibitEvilModules]
48 | [InputOutput::ProhibitTwoArgOpen]
49 | 


--------------------------------------------------------------------------------
/share/flavor/Large/lib/__PATH__/Web/C/Account.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::Web::C::Account;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | 
 6 | sub logout {
 7 |     my ($class, $c) = @_;
 8 |     $c->session->expire();
 9 |     $c->redirect('/');
10 | }
11 | 
12 | 1;
13 | 


--------------------------------------------------------------------------------
/share/flavor/Large/lib/__PATH__/__MONIKER__.pm:
--------------------------------------------------------------------------------
  1 | package <% $module %>::<% $moniker %>;
  2 | use strict;
  3 | use warnings;
  4 | use utf8;
  5 | use parent qw(<% $module %> Amon2::Web);
  6 | use File::Spec;
  7 | 
  8 | # dispatcher
  9 | use <% $module %>::<% $moniker %>::Dispatcher;
 10 | sub dispatch {
 11 |     return (<% $module %>::<% $moniker %>::Dispatcher->dispatch($_[0]) or die "response is not generated");
 12 | }
 13 | 
 14 | # setup view
 15 | use <% $module %>::<% $moniker %>::View;
 16 | {
 17 |     sub create_view {
 18 |         my $view = <% $module %>::<% $moniker %>::View->make_instance(__PACKAGE__);
 19 |         no warnings 'redefine';
 20 |         *<% $module %>::<% $moniker %>::create_view = sub { $view }; # Class cache.
 21 |         $view
 22 |     }
 23 | }
 24 | 
 25 | # load plugins
 26 | __PACKAGE__->load_plugins(
 27 |     'Web::FillInFormLite',
 28 | );
 29 | 
 30 | sub show_error {
 31 |     my ( $c, $msg, $code ) = @_;
 32 |     my $res = $c->render( 'error.tx', { message => $msg } );
 33 |     $res->code( $code || 500 );
 34 |     return $res;
 35 | }
 36 | 
 37 | # for your security
 38 | __PACKAGE__->add_trigger(
 39 |     AFTER_DISPATCH => sub {
 40 |         my ( $c, $res ) = @_;
 41 | 
 42 |         # http://blogs.msdn.com/b/ie/archive/2008/07/02/ie8-security-part-v-comprehensive-protection.aspx
 43 |         $res->header( 'X-Content-Type-Options' => 'nosniff' );
 44 | 
 45 |         # http://blog.mozilla.com/security/2010/09/08/x-frame-options/
 46 |         $res->header( 'X-Frame-Options' => 'DENY' );
 47 | 
 48 |         # Cache control.
 49 |         $res->header( 'Cache-Control' => 'private' );
 50 |     },
 51 | );
 52 | 
 53 | use HTTP::Session2::ClientStore2;
 54 | use Crypt::CBC;
 55 | use Crypt::Rijndael;
 56 | 
 57 | __PACKAGE__->add_trigger(
 58 |     BEFORE_DISPATCH => sub {
 59 |         my ( $c ) = @_;
 60 |         if ($c->req->method ne 'GET' && $c->req->method ne 'HEAD') {
 61 |             my $token = $c->req->header('X-XSRF-TOKEN') || $c->req->param('XSRF-TOKEN');
 62 |             unless ($c->session->validate_xsrf_token($token)) {
 63 |                 return $c->create_simple_status_page(
 64 |                     403, 'XSRF detected.'
 65 |                 );
 66 |             }
 67 |         }
 68 |         return;
 69 |     },
 70 | );
 71 | 
 72 | my $cipher = Crypt::CBC->new({
 73 |     key => '<% random_string(32) %>',
 74 |     cipher => 'Rijndael',
 75 | });
 76 | sub session {
 77 |     my $self = shift;
 78 | 
 79 |     if (!exists $self->{session}) {
 80 |         $self->{session} = HTTP::Session2::ClientStore2->new(
 81 |             env => $self->req->env,
 82 |             secret => '<% random_string(32) %>',
 83 |             cipher => $cipher,
 84 |         );
 85 |     }
 86 |     return $self->{session};
 87 | }
 88 | 
 89 | __PACKAGE__->add_trigger(
 90 |     AFTER_DISPATCH => sub {
 91 |         my ( $c, $res ) = @_;
 92 |         if ($c->{session} && $res->can('cookies')) {
 93 |             $c->{session}->finalize_plack_response($res);
 94 |         }
 95 |         return;
 96 |     },
 97 | );
 98 | 
 99 | 1;
100 | 


--------------------------------------------------------------------------------
/share/flavor/Large/lib/__PATH__/__MONIKER__/C/Root.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::<% $moniker %>::C::Root;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | 
 6 | sub index {
 7 |     my ($class, $c) = @_;
 8 | 
 9 |     my $counter = $c->session->get('counter') || 0;
10 |     $counter++;
11 |     $c->session->set('counter' => $counter);
12 |     return $c->render('index.tx', {
13 |         counter => $counter,
14 |     });
15 | }
16 | 
17 | sub reset_counter {
18 |     my ($class, $c) = @_;
19 | 
20 |     $c->session->remove('counter');
21 |     return $c->redirect('/');
22 | }
23 | 
24 | 1;
25 | 


--------------------------------------------------------------------------------
/share/flavor/Large/lib/__PATH__/__MONIKER__/Dispatcher.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::<% $moniker %>::Dispatcher;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use Amon2::Web::Dispatcher::RouterBoom;
 6 | use Module::Find qw(useall);
 7 | 
 8 | # Load all controller classes at loading time.
 9 | useall('<% $module %>::<% $moniker %>::C');
10 | 
11 | base '<% $module %>::<% $moniker %>::C';
12 | 
13 | get '/' => 'Root#index';
14 | post '/reset_counter' => 'Root#reset_counter';
15 | 
16 | 
17 | 1;
18 | 


--------------------------------------------------------------------------------
/share/flavor/Large/lib/__PATH__/__MONIKER__/ViewFunctions.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::<% $moniker %>::ViewFunctions;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use parent qw(Exporter);
 6 | use Module::Functions;
 7 | use File::Spec;
 8 | 
 9 | our @EXPORT = get_public_functions();
10 | 
11 | sub commify {
12 |     local $_  = shift;
13 |     1 while s/((?:\A|[^.0-9])[-+]?\d+)(\d{3})/$1,$2/s;
14 |     return $_;
15 | }
16 | 
17 | sub c { <% $module %>->context() }
18 | sub uri_with { <% $module %>->context()->req->uri_with(@_) }
19 | sub uri_for { <% $module %>->context()->uri_for(@_) }
20 | 
21 | {
22 |     my %static_file_cache;
23 |     sub static_file {
24 |         my $fname = shift;
25 |         (my $relpath = $fname) =~ s!static!static/<% $lc_moniker %>!;
26 |         my $c = <% $module %>->context;
27 |         if (not exists $static_file_cache{$relpath}) {
28 |             my $fullpath = File::Spec->catfile($c->base_dir(), $relpath);
29 |             $static_file_cache{$relpath} = (stat $fullpath)[9];
30 |         }
31 |         return $c->uri_for(
32 |             $fname, {
33 |                 't' => $static_file_cache{$relpath} || 0
34 |             }
35 |         );
36 |     }
37 | }
38 | 
39 | 1;
40 | 


--------------------------------------------------------------------------------
/share/flavor/Large/script/admin.pl:
--------------------------------------------------------------------------------
 1 | %% cascade "Minimum/script/server.pl"
 2 | 
 3 | %% override load_modules -> {
 4 | use <% $module %>::Admin;
 5 | use Plack::App::File;
 6 | use Plack::Session::Store::DBI;
 7 | use DBI;
 8 | %% }
 9 | 
10 | %% override app -> {
11 | use 5.010_001;
12 | 
13 | my $basedir = File::Spec->rel2abs(dirname(__FILE__));
14 | my $app = builder {
15 |     enable 'Plack::Middleware::Auth::Basic',
16 |         authenticator => sub { $_[0] eq 'admin' && $_[1] eq 'admin' };
17 |     enable 'Plack::Middleware::Static',
18 |         path => qr{^(?:/robots\.txt|/favicon\.ico)$},
19 |         root => File::Spec->catdir(dirname(__FILE__), '..', 'static', 'admin');
20 |     enable 'Plack::Middleware::ReverseProxy';
21 |     enable 'Plack::Middleware::Session',
22 |         store => Plack::Session::Store::DBI->new(
23 |             get_dbh => sub {
24 |                 state $db_config = <% $module %>->config->{DBI} || die "Missing configuration for DBI";
25 |                 DBI->connect( @$db_config )
26 |                     or die $DBI::errstr;
27 |             }
28 |         );
29 | 
30 |     mount '/static/' => Plack::App::File->new(root => File::Spec->catdir($basedir, '..', 'static', 'admin'))->to_app();
31 |     mount '/' => <% $module %>::Admin->to_app();
32 | };
33 | %% }
34 | 


--------------------------------------------------------------------------------
/share/flavor/Large/script/web.pl:
--------------------------------------------------------------------------------
 1 | %% cascade "Minimum/script/server.pl"
 2 | 
 3 | %% override load_modules -> {
 4 | use <% $module %>::Web;
 5 | use Plack::App::File;
 6 | use Plack::Session::Store::DBI;
 7 | use DBI;
 8 | %% }
 9 | 
10 | %% override app -> {
11 | use 5.010_001;
12 | 
13 | my $basedir = File::Spec->rel2abs(dirname(__FILE__));
14 | my $app = builder {
15 |     enable 'Plack::Middleware::Static',
16 |         path => qr{^(?:/robots\.txt|/favicon\.ico)$},
17 |         root => File::Spec->catdir(dirname(__FILE__), '..', 'static', 'web');
18 |     enable 'Plack::Middleware::ReverseProxy';
19 |     enable 'Plack::Middleware::Session',
20 |         store => Plack::Session::Store::DBI->new(
21 |             get_dbh => sub {
22 |                 state $db_config = <% $module %>->config->{DBI} || die "Missing configuration for DBI";
23 |                 DBI->connect( @$db_config )
24 |                     or die $DBI::errstr;
25 |             }
26 |         );
27 | 
28 |     mount '/static/' => Plack::App::File->new(root => File::Spec->catdir($basedir, '..', 'static', 'web'))->to_app();
29 |     mount '/' => <% $module %>::Web->to_app();
30 | };
31 | %% }
32 | 


--------------------------------------------------------------------------------
/share/flavor/Large/sql/mysql.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE sessions (
2 |     id           CHAR(72) PRIMARY KEY,
3 |     session_data LONGBLOB
4 | );
5 | CREATE TABLE IF NOT EXISTS member (
6 |     id           INTEGER NOT NULL PRIMARY KEY AUTO_INCREMENT,
7 |     name         VARCHAR(255)
8 | );
9 | 


--------------------------------------------------------------------------------
/share/flavor/Large/sql/sqlite.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE sessions (
2 |     id           CHAR(72) PRIMARY KEY,
3 |     session_data TEXT
4 | );
5 | CREATE TABLE IF NOT EXISTS member (
6 |     id           INTEGER NOT NULL PRIMARY KEY,
7 |     name         VARCHAR(255)
8 | );
9 | 


--------------------------------------------------------------------------------
/share/flavor/Large/static/admin/css/admin.css:
--------------------------------------------------------------------------------
 1 | body {
 2 |     margin-top: 50px;
 3 | }
 4 | 
 5 | footer {
 6 |     text-align: right;
 7 |     padding-right: 10px;
 8 |     padding-top: 2px; }
 9 |     footer a {
10 |         text-decoration: none;
11 |         color: black;
12 |         font-weight: bold;
13 |     }
14 | 
15 | /* smart phones */
16 | @media screen and (max-device-width: 480px) {
17 | }
18 | 
19 | .topbar-inner,.topbar .fill{
20 |     background-color:<% $color1 %>;
21 |     background-repeat:repeat-x;
22 |     background-image:-khtml-gradient(linear, left top, left bottom, from(<% $color2 %>), to(<% $color1 %>));
23 |     background-image:-moz-linear-gradient(top, <% $color2 %>, <% $color1 %>);
24 |     background-image:-ms-linear-gradient(top, <% $color2 %>, <% $color1 %>);
25 |     background-image:-webkit-gradient(linear, left top, left bottom, color-stop(0%, <% $color2 %>), color-stop(100%, <% $color1 %>));
26 |     background-image:-webkit-linear-gradient(top, <% $color2 %>, <% $color1 %>);
27 |     background-image:-o-linear-gradient(top, <% $color2 %>, <% $color1 %>);
28 |     background-image:linear-gradient(top, <% $color2 %>, <% $color1 %>);
29 |     filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='<% $color2 %>', endColorstr='<% $color1 %>', GradientType=0);
30 |     -webkit-box-shadow:0 1px 3px rgba(0, 0, 0, 0.25),inset 0 -1px 0 rgba(0, 0, 0, 0.1);
31 |     -moz-box-shadow:0 1px 3px rgba(0, 0, 0, 0.25),inset 0 -1px 0 rgba(0, 0, 0, 0.1);
32 |     box-shadow:0 1px 3px rgba(0, 0, 0, 0.25),inset 0 -1px 0 rgba(0, 0, 0, 0.1);
33 | }
34 | 


--------------------------------------------------------------------------------
/share/flavor/Large/t/00_compile.t:
--------------------------------------------------------------------------------
 1 | <% cascade "Minimum/t/00_compile.t" %>
 2 | <% override load_modules -> { %>
 3 | use <% $module %>;
 4 | use <% $module %>::Web;
 5 | use <% $module %>::Web::Dispatcher;
 6 | use <% $module %>::Web::C::Root;
 7 | use <% $module %>::Web::C::Account;
 8 | use <% $module %>::Web::ViewFunctions;
 9 | use <% $module %>::Web::View;
10 | use <% $module %>::Admin;
11 | use <% $module %>::Admin::Dispatcher;
12 | use <% $module %>::Admin::C::Root;
13 | use <% $module %>::Admin::ViewFunctions;
14 | use <% $module %>::Admin::View;
15 | <% } %>
16 | 


--------------------------------------------------------------------------------
/share/flavor/Large/t/04_admin.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use t::Util;
 5 | use Plack::Test;
 6 | use Plack::Util;
 7 | use Test::More;
 8 | 
 9 | my $admin = Plack::Util::load_psgi '<% $psgi_file %>';
10 | test_psgi
11 |     app => $admin,
12 |     client => sub {
13 |         my $cb = shift;
14 | 
15 |         # 401
16 |         {
17 |             my $req = HTTP::Request->new(GET => "http://localhost/");
18 |             my $res = $cb->($req);
19 |             is($res->code, 401, 'basic auth');
20 |         }
21 | 
22 |         # 200
23 |         {
24 |             my $req = HTTP::Request->new(GET => "http://localhost/");
25 |             $req->authorization_basic('admin', 'admin');
26 |             my $res = $cb->($req);
27 |             is($res->code, 200, 'basic auth');
28 |             like($res->content, qr{admin});
29 |         }
30 |     };
31 | 
32 | done_testing;
33 | 


--------------------------------------------------------------------------------
/share/flavor/Large/t/07_mech_links.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use t::Util;
 5 | use Plack::Test;
 6 | use Plack::Util;
 7 | use Test::More;
 8 | use Test::Requires 'Test::WWW::Mechanize::PSGI', 'HTML::TokeParser';
 9 | 
10 | my %link_tags = (
11 |     a      => 'href',
12 |     area   => 'href',
13 |     frame  => 'src',
14 |     iframe => 'src',
15 |     link   => 'href',
16 |     script => 'src',
17 | );
18 | 
19 | sub _extract_links {
20 |     my $mech = shift;
21 | 
22 |     my @links;
23 |     my $parser = HTML::TokeParser->new( \( $mech->content ) );
24 |     while ( my $token = $parser->get_tag( keys %link_tags ) ) {
25 |         push @links, $token->[1]->{ $link_tags{ $token->[0] } };
26 |     }
27 |     return grep { m{^/} } @links;
28 | }
29 | 
30 | for my $psgi (glob('script/*-server')) {
31 |     subtest $psgi => sub {
32 |         my $app = Plack::Util::load_psgi($psgi);
33 | 
34 |         my $mech = Test::WWW::Mechanize::PSGI->new( app => $app );
35 |         $mech->credentials( 'admin', 'admin' );
36 |         $mech->get_ok('/');
37 | 
38 |         my @links = _extract_links($mech);
39 |         for (@links) {
40 |             $mech->get('/');
41 |             $mech->get_ok($_);
42 |         }
43 |     };
44 | }
45 | 
46 | done_testing();
47 | 


--------------------------------------------------------------------------------
/share/flavor/Large/tmpl/admin/error.tx:
--------------------------------------------------------------------------------
 1 | : cascade "include/layout.tx"
 2 | 
 3 | : override content -> {
 4 | 
 5 | 

 6 |     An error occurred : <: $message :>
 7 | 

 8 | 
 9 | : }
10 | 


--------------------------------------------------------------------------------
/share/flavor/Large/tmpl/admin/include/layout.tx:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 |     
 5 |     <: $title || '<%= $dist %>' :>
 6 |     
 7 |     
 8 |     
 9 |     
10 |     <% $tags %>
11 |     
12 |     
13 |     
16 | 
17 | 
18 |         

19 |             

20 |                 

21 |                     <% $dist %>
22 |                 

23 |             

24 |         

25 |     

26 |     

27 |         

28 |                 <: include "include/sidebar.tx" :>
29 |         

30 |         

31 |             <: block content -> { } :>
32 |         

33 |     

34 |     

35 |         Powered by Amon2
36 |     

37 | 
38 | 
39 | 


--------------------------------------------------------------------------------
/share/flavor/Large/tmpl/admin/include/sidebar.tx:
--------------------------------------------------------------------------------
1 | 
4 | 


--------------------------------------------------------------------------------
/share/flavor/Large/tmpl/admin/index.tx:
--------------------------------------------------------------------------------
 1 | : cascade "include/layout.tx"
 2 | 
 3 | : override content -> {
 4 | 
 5 | 

 6 |     
This is a <% $dist %>'s admin site

 7 | 

 8 | 
 9 | : }
10 | 


--------------------------------------------------------------------------------
/share/flavor/Large/tmpl/web/error.tx:
--------------------------------------------------------------------------------
 1 | : cascade "include/layout.tx"
 2 | 
 3 | : override content -> {
 4 | 
 5 | 

 6 |     An error occurred : <: $message :>
 7 | 

 8 | 
 9 | : }
10 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/Build.PL:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Module::Build;
 4 | use Module::CPANfile;
 5 | use FindBin;
 6 | use lib $FindBin::Bin;
 7 | use builder::MyBuilder;
 8 | 
 9 | my $file = Module::CPANfile->load("cpanfile");
10 | my $prereq = $file->prereq_specs;
11 | 
12 | my $build = builder::MyBuilder->new(
13 |     license              => 'unknown',
14 |     dynamic_config       => 0,
15 | 
16 |     build_requires       => {
17 |         $prereq->{build} ? %{$prereq->{build}->{requires}} : (),
18 |         $prereq->{test} ? %{$prereq->{test}->{requires}} : (),
19 |     },
20 |     configure_requires   => {
21 |         %{$prereq->{configure}->{requires}},
22 |     },
23 |     requires             => {
24 |         perl => '5.008001',
25 |         %{$prereq->{runtime}->{requires}},
26 |     },
27 |     script_files => [glob('script/*'), glob('bin/*')],
28 | 
29 |     no_index    => { 'directory' => [ 'inc' ] },
30 |     name        => '<% $module %>',
31 |     module_name => '<% $module %>',
32 |     author        => 'Some Person ',
33 |     dist_abstract => 'A web site based on Amon2',
34 | 
35 |     test_files => (-d '.git' || $ENV{RELEASE_TESTING}) ? 't/ xt/' : 't/',
36 |     recursive_test_files => 1,
37 | 
38 |     create_readme  => 0,
39 |     create_license => 0,
40 | );
41 | $build->create_build_script();
42 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/builder/MyBuilder.pm:
--------------------------------------------------------------------------------
 1 | package builder::MyBuilder;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use 5.008_001;
 6 | use parent qw(Module::Build);
 7 | 
 8 | # Module:::Build's share_dir handling is not good for me.
 9 | # We need to install 'tmpl' directories to '$DIST_DIR/tmpl'. But M::B doesn't support it.
10 | sub ACTION_code {
11 |     my $self = shift;
12 |     my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share dist/, '<% $dist %>');
13 |     for my $dir (qw(tmpl static)) {
14 |         next unless -d $dir;
15 |         for my $src (@{$self->rscan_dir($dir)}) {
16 |             next if -d $src;
17 |             $self->copy_if_modified(
18 |                 from => $src,
19 |                 to_dir => File::Spec->catfile( $share_prefix )
20 |             );
21 |         }
22 |     }
23 |     $self->SUPER::ACTION_code();
24 | }
25 | 
26 | 1;
27 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/lib/__PATH__.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use parent qw/Amon2/;
 6 | our $VERSION='0.01';
 7 | use 5.008001;
 8 | 
 9 | sub load_config {
10 |     +{
11 |         'Text::Xslate' => +{}
12 |     }
13 | }
14 | 
15 | 1;
16 | __END__
17 | 
18 | =head1 NAME
19 | 
20 | <% $module %> - <% $module %>
21 | 
22 | =head1 DESCRIPTION
23 | 
24 | This is a main context class for <% $module %>
25 | 
26 | =head1 AUTHOR
27 | 
28 | <% $module %> authors.
29 | 
30 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/lib/__PATH__/Web.pm:
--------------------------------------------------------------------------------
 1 | package <% $module %>::Web;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use parent qw(<% $module %> Amon2::Web);
 6 | use File::Spec;
 7 | 
 8 | sub dispatch {
 9 |     my ($c) = @_;
10 | 
11 |     $c->render('index.tx');
12 | }
13 | 
14 | # setup view
15 | use <% $module %>::Web::View;
16 | {
17 |     my $view = <% $module %>::Web::View->make_instance(__PACKAGE__);
18 |     sub create_view { $view }
19 | }
20 | 
21 | __PACKAGE__->add_trigger(
22 |     AFTER_DISPATCH => sub {
23 |         my ( $c, $res ) = @_;
24 |         # for your security
25 |         $res->header( 'X-Content-Type-Options' => 'nosniff' );
26 |         $res->header( 'X-Frame-Options' => 'DENY' );
27 |     },
28 | );
29 | 
30 | 1;
31 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/lib/__PATH__/Web/View.pm:
--------------------------------------------------------------------------------
 1 | package <% $package // $module ~ "::Web::View" %>;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use Carp ();
 6 | use File::Spec ();
 7 | 
 8 | use File::ShareDir;
 9 | use Text::Xslate 1.6001;
10 | use <% $view_functions_package // ($module ~ "::Web::ViewFunctions") %>;
11 | 
12 | # setup view class
13 | sub make_instance {
14 |     my ($class, $context) = @_;
15 |     Carp::croak("Usage: <% $module %>::Web::View->make_instance(\$context_class)") if @_!=2;
16 | 
17 |     my $view_conf = $context->config->{'Text::Xslate'} || +{};
18 |     unless (exists $view_conf->{path}) {
19 |         my $tmpl_path = File::Spec->catdir($context->base_dir(), '<% $tmpl_path // "tmpl" %>');
20 |         if ( -d $tmpl_path ) {
21 |             # <% $tmpl_path // 'tmpl' %>
22 |             $view_conf->{path} = [ $tmpl_path ];
23 |         } else {
24 |             my $share_tmpl_path = eval { File::Spec->catdir(File::ShareDir::dist_dir('<% $dist %>'), '<% $tmpl_path // "tmpl" %>') };
25 |             if ($share_tmpl_path) {
26 |                 # This application was installed to system.
27 |                 $view_conf->{path} = [ $share_tmpl_path ];
28 |             } else {
29 |                 Carp::croak("Can't find template directory. <% $tmpl_path // 'tmpl' %> Is not available.");
30 |             }
31 |         }
32 |     }
33 |     my $view = Text::Xslate->new(+{
34 |         'syntax'   => 'Kolon',
35 |         'module'   => [
36 |             'Text::Xslate::Bridge::Star',
37 |             '<% $view_functions_package // ($module ~ "::Web::ViewFunctions") %>',
38 |         ],
39 |         'function' => {
40 |         },
41 |         ($context->debug_mode ? ( warn_handler => sub {
42 |             Text::Xslate->print( # print method escape html automatically
43 |                 '[[', @_, ']]',
44 |             );
45 |         } ) : () ),
46 |         %$view_conf
47 |     });
48 |     return $view;
49 | }
50 | 
51 | 1;
52 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/lib/__PATH__/Web/ViewFunctions.pm:
--------------------------------------------------------------------------------
 1 | package <% $package // $module ~ "::Web::ViewFunctions" %>;
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use parent qw(Exporter);
 6 | use Module::Functions;
 7 | use File::Spec;
 8 | 
 9 | our @EXPORT = get_public_functions();
10 | 
11 | sub commify {
12 |     local $_  = shift;
13 |     1 while s/((?:\A|[^.0-9])[-+]?\d+)(\d{3})/$1,$2/s;
14 |     return $_;
15 | }
16 | 
17 | sub c { <% $module %>->context() }
18 | sub uri_with { <% $module %>->context()->req->uri_with(@_) }
19 | sub uri_for { <% $module %>->context()->uri_for(@_) }
20 | 
21 | {
22 |     my %static_file_cache;
23 |     sub static_file {
24 |         my $fname = shift;
25 |         my $c = <% $module %>->context;
26 |         if (not exists $static_file_cache{$fname}) {
27 |             my $fullpath = File::Spec->catfile($c->base_dir(), $fname);
28 |             $static_file_cache{$fname} = (stat $fullpath)[9];
29 |         }
30 |         return $c->uri_for(
31 |             $fname, {
32 |                 't' => $static_file_cache{$fname} || 0
33 |             }
34 |         );
35 |     }
36 | }
37 | 
38 | 1;
39 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/minil.toml:
--------------------------------------------------------------------------------
1 | name="<% $dist %>"
2 | [build]
3 | build_class = "builder::MyBuilder"
4 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/script/server.pl:
--------------------------------------------------------------------------------
 1 | #!perl
 2 | use strict;
 3 | use warnings;
 4 | use utf8;
 5 | use File::Spec;
 6 | use File::Basename;
 7 | use lib File::Spec->catdir(dirname(__FILE__), '../lib');
 8 | use Plack::Builder;
 9 | 
10 | %% block load_modules -> {
11 | use <% $module %>::Web;
12 | %% }
13 | 
14 | %% block app -> {
15 | my $app = builder {
16 |     enable 'Plack::Middleware::AccessLog';
17 |     enable 'Plack::Middleware::Static',
18 |         path => qr{^(?:/static/)},
19 |         root => File::Spec->catdir(dirname(__FILE__), '..');
20 |     enable 'Plack::Middleware::Static',
21 |         path => qr{^(?:/robots\.txt|/favicon\.ico)$},
22 |         root => File::Spec->catdir(dirname(__FILE__), '..', 'static');
23 |     <% $module %>::Web->to_app();
24 | };
25 | %% }
26 | unless (caller) {
27 |     my $port        = 5000;
28 |     my $host        = '127.0.0.1';
29 |     my $max_workers = 4;
30 | 
31 |     require Getopt::Long;
32 |     require Plack::Loader;
33 |     my $p = Getopt::Long::Parser->new(
34 |         config => [qw(posix_default no_ignore_case auto_help)]
35 |     );
36 |     $p->getoptions(
37 |         'p|port=i'      => \$port,
38 |         'host=s'        => \$host,
39 |         'max-workers=i' => \$max_workers,
40 |         'version!'      => \my $version,
41 |         'c|config=s'    => \my $config_file,
42 |     );
43 |     if ($version) {
44 |         print "<% $module %>: $<% $module %>::VERSION\n";
45 |         exit 0;
46 |     }
47 |     if ($config_file) {
48 |         my $config = do $config_file;
49 |         Carp::croak("$config_file: $@") if $@;
50 |         Carp::croak("$config_file: $!") unless defined $config;
51 |         unless ( ref($config) eq 'HASH' ) {
52 |             Carp::croak("$config_file does not return HashRef.");
53 |         }
54 |         no warnings 'redefine';
55 |         no warnings 'once';
56 |         *<% $module %>::load_config = sub { $config }
57 |     }
58 | 
59 |     print "<% $module %>: http://${host}:${port}/\n";
60 | 
61 |     my $loader = Plack::Loader->load('Starlet',
62 |         port        => $port,
63 |         host        => $host,
64 |         max_workers => $max_workers,
65 |     );
66 |     return $loader->run($app);
67 | }
68 | return $app;
69 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/t/00_compile.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | 
 5 | <% block load_modules -> { %>
 6 | use <% $module %>;
 7 | use <% $module %>::Web;
 8 | use <% $module %>::Web::View;
 9 | use <% $module %>::Web::ViewFunctions;
10 | <% } %>
11 | 
12 | pass "All modules can load.";
13 | 
14 | done_testing;
15 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/t/01_root.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use t::Util;
 5 | use Plack::Test;
 6 | use Plack::Util;
 7 | use Test::More;
 8 | 
 9 | my $app = Plack::Util::load_psgi '<% $psgi_file // "app.psgi" %>';
10 | test_psgi
11 |     app => $app,
12 |     client => sub {
13 |         my $cb = shift;
14 |         my $req = HTTP::Request->new(GET => 'http://localhost/');
15 |         my $res = $cb->($req);
16 |         is $res->code, 200;
17 |         diag $res->content if $res->code != 200;
18 |     };
19 | 
20 | done_testing;
21 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/t/02_mech.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use t::Util;
 5 | use Plack::Test;
 6 | use Plack::Util;
 7 | use Test::More;
 8 | use Test::Requires 'Test::WWW::Mechanize::PSGI';
 9 | 
10 | my $app = Plack::Util::load_psgi '<% $psgi_file ? $psgi_file : "app.psgi" %>';
11 | 
12 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
13 | $mech->get_ok('/');
14 | 
15 | done_testing;
16 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/t/Util.pm:
--------------------------------------------------------------------------------
 1 | package t::Util;
 2 | BEGIN {
 3 |     unless ($ENV{PLACK_ENV}) {
 4 |         $ENV{PLACK_ENV} = 'test';
 5 |     }
 6 |     if ($ENV{PLACK_ENV} eq 'production') {
 7 |         die "Do not run a test script on deployment environment";
 8 |     }
 9 | }
10 | use File::Spec;
11 | use File::Basename;
12 | use lib File::Spec->rel2abs(File::Spec->catdir(dirname(__FILE__), '..', 'lib'));
13 | use parent qw/Exporter/;
14 | use Test::More 0.98;
15 | 
16 | our @EXPORT = qw(
17 | <% block export -> { } %>
18 | );
19 | 
20 | {
21 |     # utf8 hack.
22 |     binmode Test::More->builder->$_, ":utf8" for qw/output failure_output todo_output/;
23 |     no warnings 'redefine';
24 |     my $code = \&Test::Builder::child;
25 |     *Test::Builder::child = sub {
26 |         my $builder = $code->(@_);
27 |         binmode $builder->output,         ":utf8";
28 |         binmode $builder->failure_output, ":utf8";
29 |         binmode $builder->todo_output,    ":utf8";
30 |         return $builder;
31 |     };
32 | }
33 | 
34 | <% block functions -> { %>
35 | <% } %>
36 | 
37 | 1;
38 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/tmpl/index.tx:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 |     
 5 |     <% $module %>
 6 |     
 7 | 
 8 | 
 9 |     <% $module %>
10 | 
11 | 
12 | 


--------------------------------------------------------------------------------
/share/flavor/Minimum/xt/01_pod.t:
--------------------------------------------------------------------------------
1 | use strict;
2 | use warnings;
3 | use Test::More;
4 | eval "use Test::Pod 1.00";
5 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
6 | all_pod_files_ok();
7 | 


--------------------------------------------------------------------------------
/t/00_compile.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | 
 5 | use_ok($_) for qw/
 6 |     Amon2
 7 |     Amon2::Web
 8 |     Amon2::Web::Response
 9 |     Amon2::Web::Request
10 | /;
11 | 
12 | use Plack;
13 | 
14 | diag "Plack: $Plack::VERSION\n";
15 | diag "Perl: $] $^X\n";
16 | diag "INC: " . join(" ", @INC) . "\n";
17 | 
18 | done_testing;
19 | 


--------------------------------------------------------------------------------
/t/100_core/001_request_param_decoded.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Amon2::Web::Request;
 5 | use URI::Escape;
 6 | use Encode;
 7 | use Test::More;
 8 | use Amon2;
 9 | 
10 | {
11 |     package MyApp::Web;
12 |     use parent -norequire, qw/MyApp/;
13 |     use parent qw/Amon2::Web/;
14 |     sub encoding { 'utf-8' }
15 | }
16 | 
17 | {
18 |     package MyApp;
19 |     use parent qw/Amon2/;
20 | }
21 | 
22 | my $c = MyApp::Web->bootstrap();
23 | 
24 | my $req = Amon2::Web::Request->new({
25 |     QUERY_STRING   => 'foo=%E3%81%BB%E3%81%92&bar=%E3%81%B5%E3%81%8C1&bar=%E3%81%B5%E3%81%8C2',
26 |     REQUEST_METHOD => 'GET',
27 | });
28 | subtest 'normal' => sub {
29 |     ok Encode::is_utf8($req->param('foo')), 'decoded';
30 |     ok Encode::is_utf8($req->query_parameters->{'foo'}), 'decoded';
31 |     is $req->param('foo'), 'ほげ';
32 |     is_deeply [$req->param('bar')], ['ふが1', 'ふが2'];
33 | };
34 | subtest 'accessor' => sub {
35 |     ok !Encode::is_utf8($req->param_raw('foo')), 'not decoded';
36 |     ok !Encode::is_utf8($req->parameters_raw->{'foo'}), 'not decoded';
37 | };
38 | 
39 | done_testing;
40 | 


--------------------------------------------------------------------------------
/t/100_core/002_response.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Amon2::Web::Response;
 5 | use Amon2::Web::Response::Callback;
 6 | 
 7 | my $res = Amon2::Web::Response->new(200, [], 'ok');
 8 | $res->content_type('text/html');
 9 | $res->status(403);
10 | $res->body('hoge');
11 | isa_ok $res, 'Amon2::Web::Response', 'method chain';
12 | is_deeply $res->finalize(), [403, ['Content-Type' => 'text/html'], ['hoge']];
13 | 
14 | test_callback_finalize(
15 |   expected => [ 403, [ 'Content-Type' => 'text/html' ], [ 'hoge' ] ],
16 |   given => [ 403, [ 'Content-Type' => 'text/html' ], [ 'hoge' ] ],
17 | );
18 | 
19 | test_callback_finalize(
20 |   dies => 1,
21 |   given => [ 403, [ 'Content-Type' => "text/html\r\n" ], [ 'hoge' ] ],
22 | );
23 | 
24 | test_callback_finalize(
25 |   dies => 1,
26 |   given => [
27 |     403,
28 |     [ 'Content-Type' => 'text/html', 'Content-Length' => "42\r\n" ],
29 |     [ 'hoge' ],
30 |   ],
31 | );
32 | 
33 | done_testing;
34 | 
35 | sub test_callback_finalize {
36 |   my (%params) = @_;
37 | 
38 |   my $dies = delete $params{dies};
39 |   my $expected = delete $params{expected};
40 |   my $given = delete $params{given};
41 | 
42 |   my $cb_res = Amon2::Web::Response::Callback->new(
43 |     code => sub {
44 |       my ($respond) = @_;
45 |       $respond->($given);
46 |     },
47 |   );
48 | 
49 |   my ($got) = eval { $cb_res->finalize->(sub { @_ }) };
50 |   if ($dies) {
51 |     ok $@, 'Error-expected operation returned a value.';
52 |   } else {
53 |     is_deeply $got, $expected;
54 |   }
55 | }
56 | 


--------------------------------------------------------------------------------
/t/100_core/003_redirect.t:
--------------------------------------------------------------------------------
  1 | use strict;
  2 | use warnings;
  3 | use utf8;
  4 | use Amon2::Web::Request;
  5 | use Test::More;
  6 | 
  7 | {
  8 |     package MyApp::Web;
  9 |     use parent qw/Amon2 Amon2::Web/;
 10 | }
 11 | 
 12 | my $c = MyApp::Web->bootstrap();
 13 | 
 14 | # -------------------------------------------------------------------------
 15 | 
 16 | is(
 17 |     check_redirect(
 18 |         {
 19 |             HTTP_HOST   => 'example.com',
 20 |             REQUEST_URI => '/',
 21 |         },
 22 |         '/foo/'
 23 |     ),
 24 |     'http://example.com/foo/'
 25 | );
 26 | is(
 27 |     check_redirect(
 28 |         {
 29 |             HTTP_HOST   => 'example.com',
 30 |             REQUEST_URI => '/',
 31 |             SCRIPT_NAME => '/bar/',
 32 |         },
 33 |         '/foo/'
 34 |     ),
 35 |     'http://example.com/bar/foo/'
 36 | );
 37 | is(
 38 |     check_redirect(
 39 |         {
 40 |             HTTP_HOST   => 'example.com',
 41 |             REQUEST_URI => '/',
 42 |             SCRIPT_NAME => '/bar/',
 43 |         },
 44 |         'http://google.com/'
 45 |     ),
 46 |     'http://google.com/'
 47 | );
 48 | is(
 49 |     check_redirect(
 50 |         {
 51 |             HTTP_HOST   => 'example.com',
 52 |             REQUEST_URI => '/',
 53 |             SCRIPT_NAME => '/bar/',
 54 |         },
 55 |         'http://google.com/',
 56 |         ['foo' => 'bar']
 57 |     ),
 58 |     'http://google.com/?foo=bar'
 59 | );
 60 | is(
 61 |     check_redirect(
 62 |         {
 63 |             HTTP_HOST   => 'example.com',
 64 |             REQUEST_URI => '/',
 65 |             SCRIPT_NAME => '/bar/',
 66 |         },
 67 |         'http://google.com/?hoge=fuga',
 68 |         ['foo' => 'bar']
 69 |     ),
 70 |     'http://google.com/?hoge=fuga&foo=bar'
 71 | );
 72 | is(
 73 |     check_redirect(
 74 |         {
 75 |             HTTP_HOST   => 'example.com',
 76 |             REQUEST_URI => '/',
 77 |             SCRIPT_NAME => '/bar/',
 78 |         },
 79 |         'http://google.com/?foo=hoge',
 80 |         ['foo' => 'bar']
 81 |     ),
 82 |     'http://google.com/?foo=hoge&foo=bar'
 83 | );
 84 | is(
 85 |     check_redirect(
 86 |         {
 87 |             HTTP_HOST   => 'example.com',
 88 |             REQUEST_URI => '/',
 89 |             SCRIPT_NAME => '/bar/',
 90 |         },
 91 |         'http://google.com/?foo=hoge',
 92 |         ['いやん' => 'ばかん']
 93 |     ),
 94 |     'http://google.com/?foo=hoge&%E3%81%84%E3%82%84%E3%82%93=%E3%81%B0%E3%81%8B%E3%82%93'
 95 | );
 96 | is(
 97 |     check_redirect(
 98 |         {
 99 |             HTTP_HOST   => 'example.com',
100 |             REQUEST_URI => '/',
101 |             SCRIPT_NAME => '/bar/',
102 |         },
103 |         'http://google.com/?foo=hoge',
104 |         {'いやん' => 'ばかん'}
105 |     ),
106 |     'http://google.com/?foo=hoge&%E3%81%84%E3%82%84%E3%82%93=%E3%81%B0%E3%81%8B%E3%82%93'
107 | );
108 | 
109 | no warnings 'once';
110 | local *MyApp::Web::encoding = sub { 'cp932' };
111 | is(
112 |     check_redirect(
113 |         {
114 |             HTTP_HOST   => 'example.com',
115 |             REQUEST_URI => '/',
116 |             SCRIPT_NAME => '/bar/',
117 |         },
118 |         'http://google.com/?foo=hoge',
119 |         ['いやん' => 'ばかん']
120 |     ),
121 |     'http://google.com/?foo=hoge&%82%A2%82%E2%82%F1=%82%CE%82%A9%82%F1'
122 | );
123 | done_testing;
124 | 
125 | # -------------------------------------------------------------------------
126 | 
127 | sub check_redirect {
128 |     my ($env, $next, $params) = @_;
129 |     $c->{request} = Amon2::Web::Request->new($env);
130 | 
131 |     my $res = $c->redirect($next, $params);
132 |     $res->header('Location');
133 | }
134 | 
135 | 


--------------------------------------------------------------------------------
/t/100_core/004_web_to_app_leak.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | 
 6 | our $DESTROY = 0;
 7 | our $DISPATCH = 0;
 8 | 
 9 | {
10 |     package MockDB;
11 |     sub new { bless {}, shift }
12 |     sub DESTROY { $::DESTROY++ }
13 | }
14 | 
15 | {
16 |     package MyApp::Web;
17 |     use parent qw/Amon2 Amon2::Web/;
18 |     sub dispatch {
19 |         my ($c) = @_;
20 |         return $c->create_response(200, [], 'dispatch OK');
21 |     }
22 |     __PACKAGE__->add_trigger(
23 |         BEFORE_DISPATCH => sub {
24 |             my $c = shift;
25 |             $c->{mockdb} = MockDB->new();
26 |             if (!$::DISPATCH) {
27 |                 return $c->create_response(200, [], 'trigger OK');
28 |             }
29 |         }
30 |     );
31 | }
32 | 
33 | my $app = MyApp::Web->to_app();
34 | {
35 |     local $DESTROY  = 0;
36 |     local $DISPATCH = 0;
37 |     my $res = $app->(+{});
38 |     is($res->[2]->[0], 'trigger OK');
39 |     is($DESTROY, 1);
40 | }
41 | 
42 | {
43 |     local $DESTROY  = 0;
44 |     local $DISPATCH = 1;
45 |     my $res = $app->(+{});
46 |     is($res->[2]->[0], 'dispatch OK');
47 |     is($DESTROY, 1);
48 | }
49 | 
50 | done_testing;
51 | 
52 | 


--------------------------------------------------------------------------------
/t/100_core/005_trigger.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | 
 5 | {
 6 |     package MyApp;
 7 |     use Amon2::Trigger;
 8 | 
 9 |     sub new { bless { BAR => 0 }, shift }
10 | 
11 |     __PACKAGE__->add_trigger(
12 |         FOO => sub {
13 |             my $self = shift;
14 |             $self->{FOO} = 1;
15 |         },
16 |         BAR => sub {
17 |             my $self = shift;
18 |             $self->{BAR} += 1;
19 |         },
20 |     );
21 | }
22 | 
23 | subtest 'normal' => sub {
24 |     my $app = MyApp->new();
25 |     $app->call_trigger('FOO');
26 |     $app->add_trigger('BAZ', sub { $_[0]->{BAZ} = 1 });
27 |     $app->call_trigger('BAZ');
28 |     $app->add_trigger('BAR', sub { $_[0]->{BAR} += 1 });
29 |     $app->call_trigger('BAR');
30 |     is $app->{FOO}, 1;
31 |     is $app->{BAR}, 2;
32 |     is $app->{BAZ}, 1;
33 | };
34 | 
35 | # -------------------------------------------------------------------------
36 | 
37 | {
38 |     package MyApp::Parent;
39 |     use Amon2::Trigger;
40 | 
41 |     sub new { bless { BAR => 0 }, shift }
42 |     __PACKAGE__->add_trigger(
43 |         f => sub { $_[0]->{p}++ }
44 |     );
45 | 
46 |     package MyApp::Child;
47 |     our @ISA = qw/MyApp::Parent/;
48 | 
49 |     __PACKAGE__->add_trigger(
50 |         f => sub { $_[0]->{c}++ }
51 |     );
52 | }
53 | 
54 | subtest 'inheritance' => sub {
55 |     my $c = MyApp::Child->new();
56 |     $c->call_trigger('f');
57 |     ok $c->{p}, "called parent's hook";
58 |     ok $c->{c};
59 | };
60 | 
61 | done_testing;
62 | 
63 | 


--------------------------------------------------------------------------------
/t/100_core/008_request_uri_with.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Encode;
 5 | 
 6 | {
 7 |     package MyApp;
 8 |     use parent qw(Amon2 Amon2::Web);
 9 | }
10 | 
11 | my $c = MyApp->bootstrap;
12 | 
13 | subtest 'normal' => sub {
14 |     my $req = Amon2::Web::Request->new(
15 |         {
16 |             HTTP_HOST => 'localhost',
17 |             PATH_INFO => '/foo/',
18 |             QUERY_STRING => 'a=b&c=d',
19 |         },
20 |     );
21 |     my $uri = $req->uri_with({e => 'f'});
22 |     is_deeply +{$uri->query_form()}, {
23 |         e => 'f',
24 |         a => 'b',
25 |         c => 'd',
26 |     };
27 | };
28 | 
29 | subtest 'flagged key' => sub {
30 |     my $req = Amon2::Web::Request->new(
31 |         {
32 |             HTTP_HOST => 'localhost',
33 |             PATH_INFO => '/foo/',
34 |             QUERY_STRING => 'a=%E3%81%BB%E3%81%92&c=d',
35 |         },
36 |     );
37 |     my $uri = $req->uri_with({
38 |         decode_utf8('e') => 'f'
39 |     });
40 |     is_deeply +{$uri->query_form()}, {
41 |         e => 'f',
42 |         a => 'ほげ',
43 |         c => 'd',
44 |     };
45 | };
46 | 
47 | done_testing;
48 | 


--------------------------------------------------------------------------------
/t/100_core/009_uri_for.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Amon2::Web::Request;
 5 | use URI::Escape;
 6 | use Encode;
 7 | use Test::More;
 8 | use Amon2;
 9 | 
10 | {
11 |     package MyApp::Web;
12 |     use parent -norequire, qw/MyApp/;
13 |     use parent qw/Amon2::Web/;
14 |     sub dispatch { MyApp::Web::Dispatcher->dispatch(shift) }
15 |     sub encoding { 'utf-8' }
16 | }
17 | 
18 | {
19 |     package MyApp;
20 |     use parent qw/Amon2/;
21 | }
22 | 
23 | my $req = Amon2::Web::Request->new({
24 |     QUERY_STRING   => 'foo=%E3%81%BB%E3%81%92&bar=%E3%81%B5%E3%81%8C1&bar=%E3%81%B5%E3%81%8C2',
25 |     REQUEST_METHOD => 'GET',
26 |     SCRIPT_NAME => '/foo/',
27 | });
28 | my $c = MyApp::Web->new(request => $req);
29 | 
30 | my $uri = $c->uri_for('/bar/', {'boo' => 'ジョン'});
31 | is $uri, '/foo/bar/?boo=%E3%82%B8%E3%83%A7%E3%83%B3';
32 | is decode_utf8(+{URI->new($uri)->query_form}->{'boo'}), 'ジョン';
33 | 
34 | done_testing;
35 | 


--------------------------------------------------------------------------------
/t/100_core/010_add_config.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Amon2::Web::Request;
 5 | use URI::Escape;
 6 | use Encode;
 7 | use Test::More;
 8 | use Amon2;
 9 | 
10 | {
11 |     package MyApp;
12 |     use parent qw/Amon2/;
13 |     use Test::More;
14 |     sub load_config {+{
15 |         'Foo' => {
16 |             bar => 'baz',
17 |         },
18 |     }}
19 |     local $SIG{__WARN__} = sub { }; # add_config method outputs deprecated warnigns
20 |     __PACKAGE__->add_config(
21 |         'Foo' => {
22 |             'hoge' => 'fuga',
23 |         },
24 |     );
25 |     is_deeply(__PACKAGE__->config->{'Foo'}, +{ 'hoge' => 'fuga', 'bar' => 'baz'});
26 |     __PACKAGE__->add_config(
27 |         'Foo' => {
28 |             bar => 'new',
29 |         },
30 |     );
31 |     is_deeply(__PACKAGE__->config->{'Foo'}, +{ 'hoge' => 'fuga', 'bar' => 'new'});
32 | }
33 | 
34 | done_testing;
35 | 


--------------------------------------------------------------------------------
/t/100_core/011_random_string.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Amon2::Util;
 6 | 
 7 | diag sprintf("/dev/urandom: %s", $Amon2::Util::URANDOM_FH ? "available" : "unavailable");
 8 | 
 9 | my $ret = Amon2::Util::random_string(32);
10 | is length($ret), 32;
11 | 
12 | {
13 |     my $ret = join '', map { Amon2::Util::random_string(32) } 1..100;
14 |     like $ret, qr/A/;
15 |     like $ret, qr/9/;
16 | }
17 | {
18 |     local $Amon2::Util::URANDOM_FH;
19 |     my $ret = join '', map { Amon2::Util::random_string(32) } 1..100;
20 |     like $ret, qr/f/;
21 |     like $ret, qr/9/;
22 | }
23 | 
24 | for (1..100) {
25 |     is length(Amon2::Util::random_string($_)), $_;
26 |     {
27 |         local $Amon2::Util::URANDOM_FH;
28 |         is length(Amon2::Util::random_string($_)), $_;
29 |     }
30 | }
31 | 
32 | done_testing;
33 | 
34 | 


--------------------------------------------------------------------------------
/t/100_core/012_trigger_controller.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | 
 6 | {
 7 |     package MyApp::V1;
 8 |     use parent qw/Amon2 Amon2::Web/;
 9 |     __PACKAGE__->add_trigger(
10 |         BEFORE_DISPATCH => sub { 1 } # returns unblessed value
11 |     );
12 |     sub dispatch { Amon2::Web::Response->new(200, [], ['OK']) }
13 | }
14 | 
15 | is(MyApp::V1->to_app->({})->[2]->[0], 'OK');
16 | 
17 | {
18 |     package MyApp::V2;
19 |     use parent qw/Amon2 Amon2::Web/;
20 |     __PACKAGE__->add_trigger(
21 |         BEFORE_DISPATCH => sub { # returns response object
22 |             Amon2::Web::Response->new(200, [], ['OK2']);
23 |         }
24 |     );
25 |     sub dispatch { Amon2::Web::Response->new(200, [], ['NG']) }
26 | }
27 | is(MyApp::V2->to_app->({})->[2]->[0], 'OK2');
28 | 
29 | done_testing;
30 | 
31 | 


--------------------------------------------------------------------------------
/t/100_core/013_tiffany.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Test::Requires qw/Tiffany Test::WWW::Mechanize::PSGI Text::MicroTemplate/;
 6 | 
 7 | package MyApp;
 8 | use parent qw/Amon2/;
 9 | 
10 | package MyApp::Web;
11 | use Amon2::Web;
12 | our @ISA = qw/MyApp Amon2::Web/;
13 | 
14 | sub create_view { Tiffany->load('Text::MicroTemplate::File', {include_path => ['t/tmpl/']}) }
15 | 
16 | sub dispatch {
17 |     my $c = shift;
18 |     $c->render('foo.mt', 'world');
19 | }
20 | 
21 | package main;
22 | 
23 | my $app = MyApp::Web->to_app();
24 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
25 | $mech->get_ok('http://localhost/');
26 | $mech->content_like(qr/Hello, world!/);
27 | 
28 | done_testing;
29 | 
30 | 


--------------------------------------------------------------------------------
/t/100_core/014_load_plugins.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | 
 6 | $INC{"My/Plugin/$_.pm"}++ for 1..3;
 7 | my @conf;
 8 | {
 9 |     package My::Plugin;
10 | 
11 |     sub init {
12 |         my ( $class, $c, $conf ) = @_;
13 |         push @conf, [ $class, $c, $conf ];
14 |     }
15 | 
16 |     package My::Plugin::1;
17 |     use parent -norequire, qw(My::Plugin);
18 | 
19 |     package My::Plugin::2;
20 |     use parent -norequire, qw(My::Plugin);
21 | 
22 |     package My::Plugin::3;
23 |     use parent -norequire, qw(My::Plugin);
24 | }
25 | 
26 | {
27 | 	package MyApp;
28 | 	use parent qw(Amon2);
29 | 	__PACKAGE__->load_plugins(
30 | 		'+My::Plugin::1',
31 | 		'+My::Plugin::2' => +{ opt => 2 },
32 | 		'+My::Plugin::3',
33 | 	);
34 | }
35 | is_deeply(
36 |     \@conf,
37 |     [
38 |         [ 'My::Plugin::1', 'MyApp', undef ],
39 |         [ 'My::Plugin::2', 'MyApp', { 'opt' => 2 } ],
40 |         [ 'My::Plugin::3', 'MyApp', undef ]
41 |     ]
42 | );
43 | 
44 | done_testing;
45 | 
46 | 


--------------------------------------------------------------------------------
/t/100_core/015_debug_mode.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Amon2;
 6 | 
 7 | subtest 'enabled debug mode' => sub {
 8 |     local $ENV{AMON2_DEBUG} = 1;
 9 |     is(Amon2->debug_mode(), 1);
10 | };
11 | 
12 | subtest 'disabled debug mode' => sub {
13 |     local $ENV{AMON2_DEBUG} = 0;
14 |     is(Amon2->debug_mode(), 0);
15 | };
16 | 
17 | done_testing;
18 | 
19 | 


--------------------------------------------------------------------------------
/t/100_core/016_context_guard.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | 
 6 | 
 7 | subtest 'unit test' => sub {
 8 | {
 9 |     package C;
10 |     sub new {
11 |         my $class = shift;
12 |         bless {@_}, $class;
13 |     }
14 |     sub DEMOLISH { }
15 |     sub x { shift->{x} }
16 | }
17 |     my $x = C->new(x => 3);
18 |     my $guard = Amon2::ContextGuard->new(C->new(x => 4), \$x);
19 |     is($x->x, 4);
20 |     undef $guard;
21 |     is($x->x, 3);
22 | };
23 | 
24 | subtest 'with Amon2' => sub {
25 |     {
26 |         package MyApp;
27 |         use parent qw/Amon2/;
28 |     }
29 | 
30 |     my $c = MyApp->new();
31 |     my $guard = $c->context_guard();
32 |     ok(Amon2->context);
33 |     ok(MyApp->context);
34 |     isa_ok(Amon2->context, 'MyApp');
35 | };
36 | 
37 | done_testing;
38 | 
39 | 


--------------------------------------------------------------------------------
/t/100_core/017_local_context.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | 
 6 | {
 7 |     package Foo;
 8 |     use parent qw(Amon2);
 9 |     __PACKAGE__->make_local_context();
10 | }
11 | 
12 | subtest 'simple set context' => sub {
13 |     is(Foo->context(), undef);
14 |     my $c = Foo->new();
15 |     Foo->set_context($c);
16 |     is(Foo->context(), $c, 'context was set');
17 |     is(Amon2->context(), undef, 'global context does not set');
18 |     Foo->set_context(undef); # teardown
19 | };
20 | 
21 | subtest 'context_guard' => sub {
22 |     is(Foo->context(), undef);
23 |     my $c = Foo->new();
24 |     {
25 |         my $guard = $c->context_guard();
26 |         is(Foo->context(), $c, 'context was set');
27 |         is(Amon2->context(), undef, 'global context does not set');
28 |     }
29 |     is(Foo->context(), undef, 'context was gone');
30 |     is(Amon2->context(), undef, 'global context does not set');
31 | };
32 | 
33 | subtest 'bootstrap' => sub {
34 |     is(Foo->context(), undef);
35 |     my $c = Foo->bootstrap();
36 |     is(Foo->context(), $c, 'context was set');
37 |     is(Amon2->context(), undef, 'global context does not set');
38 | };
39 | 
40 | done_testing;
41 | 
42 | 


--------------------------------------------------------------------------------
/t/200_app/01_extended.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use File::Spec;
 4 | use FindBin;
 5 | use lib File::Spec->catdir($FindBin::Bin, '../..');
 6 | use t::Util;
 7 | use Test::Requires 'HTTP::MobileAgent', 'HTTP::Session', 'Text::MicroTemplate::Extended', 'Amon2::Plugin::LogDispatch', 'Log::Dispatch', 'Tiffany', 'Amon2::Plugin::Web::MobileAgent', 'Router::Simple', 'Amon2::Plugin::Web::HTTPSession';
 8 | 
 9 | $ENV{PLACK_ENV} = 'development';
10 | 
11 | run_app_test('Extended');
12 | 


--------------------------------------------------------------------------------
/t/200_app/02_deepnamespace.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use File::Spec;
 5 | use FindBin;
 6 | use lib File::Spec->catdir($FindBin::Bin, '../..');
 7 | use t::Util;
 8 | use Test::Requires 'Text::MicroTemplate::Extended', 'Tiffany', 'Module::Find';
 9 | 
10 | plan skip_all => "this test requires perl 5.10 or later" if $] < 5.010;
11 | 
12 | $ENV{PLACK_ENV} = 'development';
13 | 
14 | run_app_test('DeepNamespace');
15 | 


--------------------------------------------------------------------------------
/t/300_setup/01_minimum.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use File::Spec;
 6 | use FindBin;
 7 | use lib File::Spec->catdir($FindBin::Bin, '../..');
 8 | use t::TestFlavor;
 9 | use Test::Requires +{
10 |     'Module::Functions'               => '0',
11 | };
12 | use t::Util;
13 | 
14 | test_flavor(sub {
15 |     like slurp('cpanfile'), qr/perl/;
16 |     ok(-f 'Build.PL', 'Build.PL');
17 |     ok(-f './lib/My/App.pm', 'lib/My/App.pm exists');
18 |     ok((do './lib/My/App.pm'), 'lib/My/App.pm is valid') or do {
19 |         diag $@;
20 |         diag do {
21 |             open my $fh, '<', './lib/My/App.pm' or die;
22 |             local $/; <$fh>;
23 |         };
24 |     };
25 | }, 'Minimum');
26 | 
27 | done_testing;
28 | 
29 | 


--------------------------------------------------------------------------------
/t/300_setup/02_basic.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use File::Spec;
 6 | use FindBin;
 7 | use lib File::Spec->catdir($FindBin::Bin, '../..');
 8 | use t::TestFlavor;
 9 | use t::Util;
10 | use Test::Requires +{
11 | 	'Teng'                            => '0.18',
12 | 	'DBD::SQLite'                     => '1.33',
13 |     'DBI'                             => 0,
14 |     'Module::Functions'               => '0',
15 |     'HTML::FillInForm::Lite'          => 0,
16 |     'Plack::Middleware::ReverseProxy' => 0,
17 |     'Crypt::CBC'                      => 0,
18 |     'HTTP::Session2::ClientStore2'    => 0,
19 |     'Crypt::Rijndael' => 0,
20 | };
21 | 
22 | test_flavor(sub {
23 |     ok(-f 'Build.PL', 'Build.PL');
24 | 	like(slurp('cpanfile'), qr{HTTP::Session2});
25 | 	for my $env (qw(development production test)) {
26 | 		ok(-f "./config/${env}.pl");
27 | 		my $conf = do "./config/${env}.pl";
28 | 		is(ref($conf), 'HASH');
29 | 	}
30 |     ok(-f './lib/My/App.pm', 'lib/My/App.pm exists');
31 |     like(slurp('./lib/My/App/Web/Plugin/Session.pm'), qr{secret => '.+'});
32 |     ok((do './lib/My/App.pm'), 'lib/My/App.pm is valid') or do {
33 |         diag $@;
34 |         diag do {
35 |             open my $fh, '<', './lib/My/App.pm' or die;
36 |             local $/; <$fh>;
37 |         };
38 |     };
39 |     is( scalar( my @files = glob('./static/js/jquery-*.js') ), 1 );
40 | 	like(slurp('./cpanfile'), qr{'Teng'\s*,\s*'[0-9.]+'});
41 | }, 'Basic');
42 | 
43 | done_testing;
44 | 
45 | 


--------------------------------------------------------------------------------
/t/300_setup/03_asset.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use File::Temp qw(tempdir);
 6 | use FindBin;
 7 | use lib File::Spec->catdir($FindBin::Bin, '../..'),
 8 |     File::Spec->catdir($FindBin::Bin, '../../lib/');
 9 | use t::Util;
10 | 
11 | use Amon2::Setup::Asset::jQuery;
12 | use Amon2::Setup::Flavor;
13 | 
14 | note $INC{"Amon2/Setup/Asset/jQuery.pm"};
15 | 
16 | my $orig_cwd = Cwd::getcwd();
17 | 
18 | my $tmpdir = tempdir(CLEANUP => 1);
19 | 
20 | chdir $tmpdir;
21 | 
22 | my $flavor = Amon2::Setup::Flavor->new(module => 'Foo');
23 | $flavor->load_asset('jQuery');
24 | $flavor->load_asset('Bootstrap');
25 | $flavor->write_asset('jQuery');
26 | $flavor->write_asset('Bootstrap');
27 | ok(-f 'static/bootstrap/css/bootstrap.css');
28 | ok(-d 'static/js/');
29 | ok(-f 'static/bootstrap/js/bootstrap.js');
30 | my $jquery = []->[0];
31 | ok($jquery);
32 | ok(-f $jquery);
33 | 
34 | like($flavor->{tags}, qr/jquery-.+\.js/);
35 | like($flavor->{tags}, qr/bootstrap.css/);
36 | 
37 | chdir $orig_cwd;
38 | undef $tmpdir;
39 | 
40 | done_testing;
41 | 
42 | 


--------------------------------------------------------------------------------
/t/300_setup/06_large.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use File::Spec;
 6 | use FindBin;
 7 | use lib File::Spec->catdir($FindBin::Bin, '../..');
 8 | use t::Util;
 9 | use t::TestFlavor;
10 | use Test::Requires {
11 | 	'Mouse'             => '0.95', # Mouse::Util
12 | 	'Teng'                            => '0.18',
13 | 	'DBD::SQLite'                     => '1.33',
14 |     'Plack::Session'                  => '0.14',
15 |     'Module::Find'                    => '0.10',
16 |     'Test::WWW::Mechanize::PSGI'      => 0,
17 |     'Module::Functions'               => '0',
18 |     'HTML::FillInForm::Lite'          => 0,
19 |     'Router::Boom'                    => '0.03',
20 |     'Plack::Middleware::ReverseProxy' => 0,
21 |     'HTTP::Session2::ClientStore2'    => 0,
22 |     'Crypt::CBC'                      => 0,
23 |     'Crypt::Rijndael' => 0,
24 | };
25 | 
26 | plan skip_all => 'this test requires "sqlite3" command'
27 |   if system("sqlite3 -version") != 0;
28 | 
29 | test_flavor(sub {
30 |     ok(!-e 'xxx');
31 |     ok(!-e 'yyy');
32 |     my @files = ();
33 |     is(0+@files, 0);
34 | 
35 |     system('sqlite3 db/test.db < sql/sqlite.sql');
36 |     system('sqlite3 db/development.db < sql/sqlite.sql');
37 | 
38 |     for my $dir (qw(tmpl/ tmpl/web tmpl/admin/ static/web static/admin)) {
39 |         ok(-d $dir, $dir);
40 |     }
41 | 	for my $file (qw(Build.PL lib/My/App.pm t/Util.pm .proverc tmpl/web/error.tx tmpl/admin/error.tx)) {
42 | 		ok(-f $file, "$file exists");
43 | 	}
44 |     for my $f (qw(lib/My/App/PC.pm lib/My/App/PC/ tmpl/index.tx)) {
45 |         ok(!-e $f, "There is no $f");
46 |     }
47 | 
48 |     for my $type (qw(web admin)) {
49 |         my $f = "script/my-app-${type}-server";
50 |         my $buff = << "...";
51 | \$SIG{__WARN__} = sub { die 'Warned! ' . shift };
52 | @{[slurp($f)]}
53 | ...
54 |         open my $fh, '>', $f;
55 |         print $fh $buff;
56 |         close $fh;
57 |     }
58 | 
59 |     subtest 'test web' => sub {
60 |         my $app = Plack::Util::load_psgi("script/my-app-web-server");
61 |         my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
62 |         my $res = $mech->get('http://localhost/');
63 |         is($res->code, 200);
64 |         like($res->decoded_content,qr(static/css/main.css\?t=\d{10}),'fuction static_file success');
65 |     };
66 | 
67 |     subtest 'admin' => sub {
68 |         my $app = Plack::Util::load_psgi("script/my-app-admin-server");
69 |         my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
70 |         {
71 |             my $res = $mech->get('http://localhost/');
72 |             is($res->code, 401);
73 |         }
74 |         {
75 |             $mech->credentials('admin', 'admin');
76 |             my $res = $mech->get('http://localhost/');
77 |             is($res->code, 200);
78 |         };
79 |     };
80 | 
81 |     like(slurp('tmpl/web/include/layout.tx'), qr{jquery}, 'loads jquery');
82 | }, 'Large');
83 | 
84 | done_testing;
85 | 
86 | 


--------------------------------------------------------------------------------
/t/300_setup/07_run_cli_server.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Test::TCP;
 6 | use Amon2::Setup::Flavor::Minimum;
 7 | use File::Temp;
 8 | use Test::Requires 'File::pushd', 'Furl', 'Module::Functions', 'Starlet';
 9 | 
10 | my $tmpdir = File::Temp::tempdir( CLEANUP => 1 );
11 | {
12 |     my $guard = pushd($tmpdir);
13 | 
14 |     my $flavor = Amon2::Setup::Flavor::Minimum->new(module => 'My::App');
15 |     $flavor->run;
16 | 
17 |     note `tree .`;
18 |     ok -f 'script/my-app-server';
19 |     test_tcp(
20 |         client => sub {
21 |             my $port = shift;
22 |             my $furl = Furl->new();
23 |             my $res = $furl->get("http://127.0.0.1:${port}/");
24 |             ok($res->is_success) or $res->content;
25 |         },
26 |         server => sub {
27 |             my $port = shift;
28 |             exec $^X, '-Ilib', 'script/my-app-server', '-p', $port;
29 |             die "Should not reach here";
30 |         },
31 |     );
32 | }
33 | 
34 | done_testing;
35 | 
36 | 


--------------------------------------------------------------------------------
/t/300_setup/08_installable.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Test::Requires 'File::Which', 'File::Temp', 'File::pushd', 'Furl';
 6 | use File::Temp;
 7 | use Amon2::Setup::Flavor::Minimum;
 8 | use Test::TCP;
 9 | 
10 | my $cpanm = which('cpanm');
11 | plan skip_all => 'Missing cpanm' unless $cpanm;
12 | plan skip_all => 'AUTHOR_TESTING and TRAVIS only.' unless $ENV{AUTHOR_TESTING} || $ENV{TRAVIS};
13 | 
14 | my $tmpdir = File::Temp::tempdir( CLEANUP => 1 );
15 | my $libdir = File::Temp::tempdir( CLEANUP => 1 );
16 | {
17 |     my $guard = pushd($tmpdir);
18 | 
19 |     my $flavor = Amon2::Setup::Flavor::Minimum->new(module => 'My::App');
20 |     $flavor->run;
21 |     system("$^X Build.PL");
22 |     system("./Build");
23 |     note `tree .`;
24 | }
25 | is system($^X, '--', $cpanm, '--installdeps', '-l', $libdir, $tmpdir), 0;
26 | is system($^X, '--', $cpanm, '--verbose', '--no-interactive', '-l', $libdir, $tmpdir), 0;
27 | note `tree $libdir`;
28 | 
29 | test_tcp(
30 |     client => sub {
31 |         my $port = shift;
32 |         my $ua = Furl->new();
33 |         my $res = $ua->get("http://127.0.0.1:${port}/");
34 |         is($res->code, 200);
35 |     },
36 |     server => sub {
37 |         my $port = shift;
38 |         exec $^X, "-Mlib=$libdir/lib/perl5/", "$libdir/bin/my-app-server", '-p', $port;
39 |         die;
40 |     },
41 | );
42 | 
43 | done_testing;
44 | 
45 | 


--------------------------------------------------------------------------------
/t/300_setup/09_minil_migrate.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Test::Requires 'File::Which', 'File::Temp', 'File::pushd', 'LWP::UserAgent';
 6 | use File::Temp;
 7 | use Amon2::Setup::Flavor::Minimum;
 8 | use Amon2::Setup::Flavor::Basic;
 9 | use Amon2::Setup::Flavor::Large;
10 | use Test::TCP;
11 | use File::Spec::Functions;
12 | use FindBin;
13 | use lib catdir($FindBin::Bin, '../..');
14 | use t::Util qw(slurp);
15 | 
16 | my $cpanm   = which('cpanm');
17 | my $minil   = which('minil');
18 | my $git     = which('git');
19 | my $sqlite3 = which('sqlite3');
20 | plan skip_all => 'Missing cpanm' unless $cpanm;
21 | plan skip_all => 'Missing minil' unless $minil;
22 | plan skip_all => 'Missing git'   unless $git;
23 | plan skip_all => 'Missing sqlite3'   unless $sqlite3;
24 | plan skip_all => 'AUTHOR_TESTING and TRAVIS only.' unless $ENV{AUTHOR_TESTING} || $ENV{TRAVIS};
25 | 
26 | run_tests('Amon2::Setup::Flavor::Large', 'my-app-admin-server');
27 | run_tests('Amon2::Setup::Flavor::Large', 'my-app-web-server');
28 | run_tests('Amon2::Setup::Flavor::Minimum', 'my-app-server');
29 | run_tests('Amon2::Setup::Flavor::Basic', 'my-app-server');
30 | 
31 | done_testing;
32 | 
33 | sub run_tests {
34 |     my ($flavor_class, $script) = @_;
35 | 
36 |     subtest "$flavor_class -> $script" => sub {
37 |         my $tmpdir = File::Temp::tempdir( CLEANUP => 1 );
38 |         my $libdir = File::Temp::tempdir( CLEANUP => 1 );
39 |         my $dbdir = File::Temp::tempdir( CLEANUP => 1 );
40 |         my $workdir = catdir($tmpdir, 'My-App');
41 |         {
42 |             mkdir $workdir;
43 |             my $guard = pushd($workdir);
44 | 
45 |             my $flavor = $flavor_class->new(module => 'My::App');
46 |             $flavor->run;
47 |             is system($git, 'init'), 0;
48 |             is system($git, 'add', '.'), 0;
49 |             is system($git, 'commit', '-m', 'initial import'), 0;
50 |             is system($^X, '--', $minil, 'migrate'), 0;
51 |             ok -f 'META.json', 'Generated META.json';
52 |         }
53 |         my @opts = ();
54 |         # my @opts = ('--verbose', '--no-interactive');
55 |         is system($^X, '--', $cpanm, @opts, '--installdeps', '-l', $libdir, $workdir), 0;
56 |         is system($^X, '--', $cpanm, @opts, '-l', $libdir, $workdir), 0;
57 | 
58 |         if (-f "$workdir/sql/sqlite.sql") {
59 |             diag "Installing sql";
60 |             is system("$sqlite3 $dbdir/test.db < $workdir/sql/sqlite.sql"), 0;
61 |         }
62 | 
63 |         my $conf = File::Temp->new();
64 |         print {$conf} <<"...";
65 | use File::Spec;
66 | use File::Basename qw(dirname);
67 | +{
68 |     'DBI' => [
69 |         "dbi:SQLite:dbname=$dbdir/test.db", '', '',
70 |         +{
71 |             sqlite_unicode => 1,
72 |         }
73 |     ],
74 | };
75 | ...
76 | 
77 |         note slurp("$libdir/bin/${script}");
78 | 
79 |         test_tcp(
80 |             client => sub {
81 |                 my $port = shift;
82 |                 my $ua = LWP::UserAgent->new();
83 |                 $ua->credentials( "127.0.0.1:${port}", 'restricted area', 'admin', 'admin');
84 |                 my $res = $ua->get("http://127.0.0.1:${port}/");
85 |                 is($res->code, 200);
86 |             },
87 |             server => sub {
88 |                 my $port = shift;
89 |                 exec $^X, "-Mlib=$libdir/lib/perl5/", '--', "$libdir/bin/${script}", '-p', $port, '-c', $conf;
90 |                 die;
91 |             },
92 |         );
93 |     };
94 | }
95 | 
96 | 


--------------------------------------------------------------------------------
/t/600_plugins/005_fillin_form_lite.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'HTML::FillInForm::Lite', 'Tiffany', 'Text::MicroTemplate::File';
 5 | use File::Spec;
 6 | use File::Temp qw/tempdir/;
 7 | 
 8 | my $tmp = tempdir(CLEANUP => 1);
 9 | 
10 | {
11 |     package MyApp;
12 |     use parent qw/Amon2/;
13 | 
14 |     package MyApp::Web;
15 |     use parent -norequire, qw/MyApp/;
16 |     use parent qw/Amon2::Web/;
17 |     use Tiffany;
18 |     sub create_view { Tiffany->load('Text::MicroTemplate::File',  { include_path => [$tmp] } ) }
19 | 
20 |     sub dispatch {
21 |         my $c = shift;
22 |         $c->fillin_form(+{body => 'hello'});
23 |         $c->render('hoge.mt');
24 |     }
25 |     __PACKAGE__->load_plugins(
26 |         'Web::FillInFormLite' => {},
27 |     );
28 | }
29 | 
30 | my $c = MyApp::Web->bootstrap();
31 | 
32 | {
33 |     open my $fh, '>', File::Spec->catfile($tmp, 'hoge.mt') or die $!;
34 |     print $fh <<'...';
35 | 
36 | 
37 | 
38 | 
39 | 

40 | 
41 | 
42 | 

43 | 
44 | 
45 | ...
46 |     close $fh;
47 | }
48 | 
49 | subtest 'new style' => sub {
50 |     my $res = MyApp::Web->to_app()->(+{});
51 |     like $res->[2]->[0], qr{};
52 |     is Plack::Util::header_get($res->[1], 'Content-Length'), length($res->[2]->[0]);
53 | };
54 | 
55 | subtest 'old style' => sub {
56 |     local $SIG{__WARN__} = sub { };
57 |     my $res = $c->render('hoge.mt')->fillin_form({body => "hello"});
58 |     like $res->body(), qr{};
59 |     is $res->content_length, length($res->body);
60 | };
61 | 
62 | done_testing;
63 | 


--------------------------------------------------------------------------------
/t/600_plugins/007_json.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'JSON';
 5 | use JSON 2;
 6 | 
 7 | {
 8 |     package MyApp;
 9 |     use parent qw/Amon2/;
10 | }
11 | 
12 | {
13 |     package MyApp::Web;
14 |     use parent -norequire, qw/MyApp/;
15 |     use parent qw/Amon2::Web/;
16 | 
17 |     __PACKAGE__->load_plugins(
18 |         'Web::JSON',
19 |     );
20 |     sub encoding { 'utf-8' }
21 | }
22 | 
23 | my $c = MyApp::Web->new(request => Amon2::Web::Request->new(+{}));
24 | # normal
25 | {
26 |     my $res = $c->render_json(+{"foo"=>"bar"});
27 |     is $res->status, 200;
28 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
29 |     is $res->content, '{"foo":"bar"}';
30 | }
31 | 
32 | # xss
33 | {
34 |     my $src = { "foo" => "" };
35 |     my $res = $c->render_json($src);
36 |     is $res->status, 200;
37 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
38 |     is $res->content, '{"foo":"\u003cscript\u003ealert(document.location)\u003c/script\u003e"}';
39 |     is_deeply decode_json($res->content), $src;
40 | }
41 | done_testing;
42 | 
43 | 


--------------------------------------------------------------------------------
/t/600_plugins/007_json_default_encoding.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'JSON';
 5 | 
 6 | {
 7 |     package MyApp;
 8 |     use parent qw/Amon2/;
 9 | }
10 | 
11 | {
12 |     package MyApp::Web;
13 |     use parent -norequire, qw/MyApp/;
14 |     use parent qw/Amon2::Web/;
15 | 
16 |     __PACKAGE__->load_plugins(
17 |         'Web::JSON',
18 |     );
19 | }
20 | 
21 | my $ua_opera  = 'Mozilla/4.0 (compatible; MSIE 6.0; X11; Linux i686; ja) Opera 10.10';
22 | my $ua_safari = 'Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_6_3; ja-jp) AppleWebKit/533.16 (KHTML, like Gecko) Version/5.0 Safari/533.16';
23 | my $ua_chrome = 'Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US) AppleWebKit/534.10 (KHTML, like Gecko) Chrome/8.0.552.215 Safari/534.10';
24 | {
25 |     my $c = MyApp::Web->new(request => Amon2::Web::Request->new(+{}));
26 |     my $res = $c->render_json(+{"foo"=>"bar"});
27 |     is $res->status, 200;
28 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
29 |     is $res->content, '{"foo":"bar"}';
30 | }
31 | {
32 |     my $c = MyApp::Web->new(request => Amon2::Web::Request->new(+{
33 |         HTTP_USER_AGENT => $ua_opera
34 |     }));
35 |     my $res = $c->render_json(+{"foo"=>"bar"});
36 |     is $res->status, 200;
37 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
38 |     is $res->content, '{"foo":"bar"}';
39 | }
40 | {
41 |     my $c = MyApp::Web->new(request => Amon2::Web::Request->new(+{
42 |         HTTP_USER_AGENT => $ua_safari
43 |     }));
44 |     my $res = $c->render_json(+{"foo"=>"bar"});
45 |     is $res->status, 200;
46 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
47 |     is $res->content, '{"foo":"bar"}';
48 | }
49 | {
50 |     my $c = MyApp::Web->new(request => Amon2::Web::Request->new(+{
51 |         HTTP_USER_AGENT => $ua_chrome
52 |     }));
53 |     my $res = $c->render_json(+{"foo"=>"bar"});
54 |     is $res->status, 200;
55 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
56 |     is $res->content, '{"foo":"bar"}';
57 | }
58 | {
59 |     my $c = MyApp::Web->new(request => Amon2::Web::Request->new(+{
60 |         HTTP_USER_AGENT => $ua_chrome,
61 |         HTTP_X_REQUESTED_WITH => 'XMLHttpRequest'
62 |     }));
63 |     my $res = $c->render_json(+{"foo"=>"bar"});
64 |     is $res->status, 200;
65 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
66 |     is $res->content, '{"foo":"bar"}';
67 | }
68 | done_testing;
69 | 
70 | 


--------------------------------------------------------------------------------
/t/600_plugins/007_json_hijacking.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Test::Requires 'JSON';
 6 | 
 7 | my $app = do {
 8 |     package MyApp;
 9 |     use parent qw(Amon2::Web Amon2);
10 |     __PACKAGE__->load_plugins(qw(Web::JSON));
11 |     __PACKAGE__->new();
12 | };
13 | subtest 'without X-Requested-With header' => sub {
14 |     $app->{request} = Amon2::Web::Request->new(
15 |         +{
16 |             'HTTP_USER_AGENT' => 'Mozilla/5.0 (Linux; U; Android 2.3.2; ja-jp; SonyEricssonSO-01C Build/3.0.D.2.79) AppleWebKit/533.1 (KHTML, like Gecko) Version/4.0 Mobile Safari/533.1',
17 |             'HTTP_COOKIE' => 'nantoka_sid=foo',
18 |         }
19 |     );
20 |     my $res = $app->render_json({});
21 |     is($res->code, 403);
22 |     is($res->content_length, length($res->content));
23 | };
24 | subtest 'POST request' => sub {
25 |     $app->{request} = Amon2::Web::Request->new(
26 |         +{
27 |             'REQUEST_METHOD' => 'POST',
28 |             'HTTP_USER_AGENT' => 'Mozilla/5.0 (Linux; U; Android 2.3.2; ja-jp; SonyEricssonSO-01C Build/3.0.D.2.79) AppleWebKit/533.1 (KHTML, like Gecko) Version/4.0 Mobile Safari/533.1',
29 |             'HTTP_COOKIE' => 'nantoka_sid=foo',
30 |         }
31 |     );
32 |     my $res = $app->render_json({});
33 |     is($res->code, 200);
34 |     is($res->content_length, length($res->content));
35 | };
36 | 
37 | subtest 'with X-Requested-With header' => sub {
38 |     $app->{request} = Amon2::Web::Request->new(
39 |         +{
40 |             'HTTP_USER_AGENT' => 'Mozilla/5.0 (Linux; U; Android 2.3.2; ja-jp; SonyEricssonSO-01C Build/3.0.D.2.79) AppleWebKit/533.1 (KHTML, like Gecko) Version/4.0 Mobile Safari/533.1',
41 |             'HTTP_COOKIE' => 'nantoka_sid=foo',
42 |             'HTTP_X_REQUESTED_WITH' => 'XMLHttpRequest',
43 |         }
44 |     );
45 |     my $res = $app->render_json({});
46 |     is($res->code, 200);
47 |     is($res->content, "{}");
48 | };
49 | 
50 | done_testing;
51 | 
52 | 


--------------------------------------------------------------------------------
/t/600_plugins/007_json_keysort.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'JSON';
 5 | use JSON 2;
 6 | 
 7 | {
 8 |     package MyApp;
 9 |     use parent qw/Amon2/;
10 | }
11 | 
12 | {
13 |     package MyApp::Web;
14 |     use parent -norequire, qw/MyApp/;
15 |     use parent qw/Amon2::Web/;
16 | 
17 |     __PACKAGE__->load_plugins(
18 |         'Web::JSON' => { canonical => 1 }
19 |     );
20 | }
21 | 
22 | my $c = MyApp::Web->new(request => Amon2::Web::Request->new(+{}));
23 | {
24 |     my $res = $c->render_json(+{ a=>1, b=>2, c=>3, d=>4, e=>5, f=>6, g=>7, h=>8, i=>9 });
25 | 
26 |     is $res->status, 200;
27 |     is $res->header('Content-Type'), 'application/json; charset=utf-8';
28 |     is $res->content, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|;
29 | }
30 | 
31 | done_testing;
32 | 
33 | 


--------------------------------------------------------------------------------
/t/600_plugins/007_json_x_api_status.t:
--------------------------------------------------------------------------------
  1 | use strict;
  2 | use warnings;
  3 | use utf8;
  4 | use Test::More;
  5 | use Test::Requires 'JSON';
  6 | 
  7 | subtest 'default' => sub {
  8 |     my $app = do {
  9 |         package MyApp;
 10 |         use parent qw(Amon2::Web Amon2);
 11 |         __PACKAGE__->load_plugins(qw(Web::JSON));
 12 |         __PACKAGE__->new();
 13 |     };
 14 |     $app->{request} = Amon2::Web::Request->new(+{});
 15 | 
 16 |     my $res = $app->render_json({ status => 200 });
 17 |     is($res->code, 200);
 18 |     is($res->header('X-API-Status'), undef);
 19 |     is $res->content, '{"status":200}';
 20 | };
 21 | 
 22 | subtest 'set status_code_field = undef' => sub {
 23 |     my $app = do {
 24 |         package MyApp2;
 25 |         use parent qw(Amon2::Web Amon2);
 26 |         __PACKAGE__->load_plugins(
 27 |             'Web::JSON' => { status_code_field => undef }
 28 |         );
 29 |         __PACKAGE__->new();
 30 |     };
 31 |     $app->{request} = Amon2::Web::Request->new(+{});
 32 | 
 33 |     my $res = $app->render_json({ status => 200 });
 34 |     is($res->code, 200);
 35 |     is($res->header('X-API-Status'), undef);
 36 |     is $res->content, '{"status":200}';
 37 | };
 38 | 
 39 | subtest 'set status_code_field = "error"' => sub {
 40 |     my $app = do {
 41 |         package MyApp3;
 42 |         use parent qw(Amon2::Web Amon2);
 43 |         __PACKAGE__->load_plugins(
 44 |             'Web::JSON' => { status_code_field => 'error' }
 45 |         );
 46 |         __PACKAGE__->new();
 47 |     };
 48 |     $app->{request} = Amon2::Web::Request->new(+{});
 49 | 
 50 |     subtest 'not have a status_code_field' => sub {
 51 |         my $res = $app->render_json({});
 52 |         is($res->code, 200);
 53 |         is($res->header('X-API-Status'), undef);
 54 |         is $res->content, '{}';
 55 |     };
 56 | 
 57 |     subtest 'have a status_code_field' => sub {
 58 |         my $res = $app->render_json({ error => 402 });
 59 |         is($res->code, 200);
 60 |         is($res->header('X-API-Status'), '402');
 61 |         is $res->content, '{"error":402}';
 62 |     };
 63 | };
 64 | 
 65 | subtest 'set status_code_field = ""' => sub {
 66 |     my $app = do {
 67 |         package MyApp4;
 68 |         use parent qw(Amon2::Web Amon2);
 69 |         __PACKAGE__->load_plugins(
 70 |             'Web::JSON' => { status_code_field => '' }
 71 |         );
 72 |         __PACKAGE__->new();
 73 |     };
 74 |     $app->{request} = Amon2::Web::Request->new(+{});
 75 | 
 76 |     subtest 'not have a status_code_field' => sub {
 77 |         my $res = $app->render_json({});
 78 |         is($res->code, 200);
 79 |         is($res->header('X-API-Status'), undef);
 80 |         is $res->content, '{}';
 81 |     };
 82 | 
 83 |     subtest 'have a status_code_field' => sub {
 84 |         my $res = $app->render_json({ '' => 402 });
 85 |         is($res->code, 200);
 86 |         is($res->header('X-API-Status'), '402');
 87 |         is $res->content, '{"":402}';
 88 |     };
 89 | };
 90 | 
 91 | subtest 'set status_code_field = "0"' => sub {
 92 |     my $app = do {
 93 |         package MyApp5;
 94 |         use parent qw(Amon2::Web Amon2);
 95 |         __PACKAGE__->load_plugins(
 96 |             'Web::JSON' => { status_code_field => '0' }
 97 |         );
 98 |         __PACKAGE__->new();
 99 |     };
100 |     $app->{request} = Amon2::Web::Request->new(+{});
101 | 
102 |     subtest 'not have a status_code_field' => sub {
103 |         my $res = $app->render_json({});
104 |         is($res->code, 200);
105 |         is($res->header('X-API-Status'), undef);
106 |         is $res->content, '{}';
107 |     };
108 | 
109 |     subtest 'have a status_code_field' => sub {
110 |         my $res = $app->render_json({ '0' => 402 });
111 |         is($res->code, 200);
112 |         is($res->header('X-API-Status'), '402');
113 |         is $res->content, '{"0":402}';
114 |     };
115 | };
116 | 
117 | done_testing;
118 | 
119 | 


--------------------------------------------------------------------------------
/t/600_plugins/008_no_cache.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'Test::WWW::Mechanize::PSGI', 'HTTP::Session', 'HTML::StickyQuery';
 5 | use Plack::Middleware::Lint;
 6 | 
 7 | {
 8 |     package MyApp;
 9 |     use parent qw/Amon2/;
10 | 
11 |     package MyApp::Web;
12 |     use parent -norequire, qw/MyApp/;
13 |     use parent qw/Amon2::Web/;
14 | 
15 |     __PACKAGE__->load_plugins( 'Web::NoCache' );
16 | 
17 |     sub dispatch {
18 |         my ($c) = @_;
19 |         return $c->create_response(
20 |             200, [], []
21 |         );
22 |     }
23 | }
24 | 
25 | my $app = MyApp::Web->to_app();
26 | my $mech = Test::WWW::Mechanize::PSGI->new( app => $app, );
27 | $mech->get_ok('/');
28 | is $mech->response->header('Cache-Control'), 'no-cache';
29 | is $mech->response->header('Pragma'), 'no-cache';
30 | 
31 | done_testing;
32 | 
33 | 


--------------------------------------------------------------------------------
/t/600_plugins/010_plack_session.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Test::More;
 5 | use Test::Requires 'Test::WWW::Mechanize::PSGI', 'Plack::Session';
 6 | use Plack::Middleware::Lint;
 7 | use Plack::Middleware::Session;
 8 | use Plack::Builder;
 9 | 
10 | {
11 |     package MyApp;
12 |     use parent qw/Amon2/;
13 |     sub load_config { +{} }
14 | 
15 |     package MyApp::Web;
16 |     use Amon2::Web;
17 |     our @ISA = qw/MyApp Amon2::Web/;
18 | 
19 |     sub dispatch {
20 |         my $c = shift;
21 |         my $cnt = $c->session->get('cnt' || 0);
22 |         ++$cnt;
23 |         $c->session->set('cnt' => $cnt);
24 |         return $c->create_response(200, [], [$cnt]);
25 |     }
26 | 
27 |     __PACKAGE__->load_plugins('Web::PlackSession');
28 | }
29 | 
30 | my $app = builder {
31 |     enable 'Session';
32 |     enable 'Lint';
33 | 
34 |     MyApp::Web->to_app()
35 | };
36 | my $mech = Test::WWW::Mechanize::PSGI->new( app => $app, );
37 | $mech->get_ok('/');
38 | is $mech->content(), '1';
39 | $mech->get_ok('/');
40 | is $mech->content(), '2';
41 | 
42 | done_testing;
43 | 


--------------------------------------------------------------------------------
/t/600_plugins/012_streaming.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Plack::Util;
 5 | use Plack::Test;
 6 | use Test::More;
 7 | use HTTP::Request::Common;
 8 | $Plack::Test::Impl = "Server";
 9 | 
10 | use Amon2;
11 | 
12 | {
13 |     package MyApp::Web;
14 |     use parent -norequire, qw/MyApp/;
15 |     use parent qw/Amon2::Web/;
16 |     sub dispatch {
17 |         my $c = shift;
18 |         $c->streaming(sub {
19 |             my ($respond) = @_;
20 |             my $writer = $respond->(
21 |                 [200, ['Content-Type', 'text/html']]);
22 |             $writer->write("\n");
23 |             for my $i (1..5) {
24 |                 $writer->write("
$i
\n");
25 |             }
26 |             $writer->write("\n");
27 |             $writer->close;
28 |         });
29 |     }
30 | }
31 | 
32 | {
33 |     package MyApp;
34 |     use parent qw/Amon2/;
35 |     __PACKAGE__->load_plugin('Amon2::Plugin::Web::Streaming');
36 | }
37 | 
38 | my $app = MyApp::Web->to_app();
39 | 
40 | test_psgi $app, sub {
41 |     my $cb = shift;
42 |     my $res = $cb->(GET "/");
43 |     is $res->content, <<"...";
44 | 
45 | 
1

46 | 
2

47 | 
3

48 | 
4

49 | 
5

50 | 
51 | ...
52 | };
53 | 
54 | done_testing;
55 | 


--------------------------------------------------------------------------------
/t/600_plugins/013_websocket.t:
--------------------------------------------------------------------------------
  1 | use strict;
  2 | use warnings;
  3 | use utf8;
  4 | use Test::More;
  5 | use Test::Requires 'Twiggy', 'Protocol::WebSocket::Handshake::Client';
  6 | use Test::Requires {
  7 |     'Protocol::WebSocket' => '0.00906',
  8 | };
  9 | use Test::TCP;
 10 | use AnyEvent;
 11 | use AnyEvent::Handle;
 12 | use AnyEvent::Socket;
 13 | use Protocol::WebSocket;
 14 | use Twiggy::Server;
 15 | 
 16 | use_ok 'Amon2::Plugin::Web::WebSocket';
 17 | 
 18 | use Amon2;
 19 | {
 20 |     package MyApp::Web;
 21 |     use parent qw/ Amon2 Amon2::Web /;
 22 |     use Test::More;
 23 |     __PACKAGE__->load_plugin('Amon2::Plugin::Web::WebSocket');
 24 | 
 25 |     sub dispatch {
 26 |         my $c = shift;
 27 | 
 28 |         $c->websocket( sub {
 29 |                 my $ws = shift;
 30 | 
 31 |                 $ws->on_receive_message( sub {
 32 |                         my ($c, $message) = @_;
 33 |                         ok $c;
 34 |                         isa_ok $c, 'Amon2::Web';
 35 |                         is $message, 'client-send';
 36 | 
 37 |                         $ws->call_eof($c);
 38 |                         $ws->call_error($c);
 39 |                         $ws->send_message('server-send');
 40 |                     },
 41 |                 );
 42 |                 $ws->on_eof(sub {
 43 |                         my ($c) = @_;
 44 |                         ok $c;
 45 |                         isa_ok $c, 'Amon2::Web';
 46 |                     },
 47 |                 );
 48 |                 $ws->on_error(sub {
 49 |                         my ($c) = @_;
 50 |                         ok $c;
 51 |                         isa_ok $c, 'Amon2::Web';
 52 | 
 53 |                         AE::cv->send;
 54 |                     },
 55 |                 );
 56 |             },
 57 |         );
 58 |     }
 59 | }
 60 | 
 61 | my $client = sub {
 62 |     my ($host, $port) = @_;
 63 |     my $cv = AE::cv;
 64 |     my $handle; $handle = AnyEvent::Handle->new(
 65 |         connect => [$host, $port],
 66 |         on_connect => sub {
 67 |             my $hs = Protocol::WebSocket::Handshake::Client->new(url => "ws://$host:$port");
 68 |             $handle->push_write($hs->to_string);
 69 |         },
 70 |     );
 71 | 
 72 |     $handle->on_read( sub {
 73 |             my $h = shift;
 74 |             like $h->rbuf, qr/Upgrade/;
 75 | 
 76 |             my $frame = Protocol::WebSocket::Frame->new('client-send');
 77 |             $h->push_write($frame->to_bytes);
 78 | 
 79 |             delete $h->{rbuf};
 80 | 
 81 |             $h->on_read( sub {
 82 |                     my $frame = Protocol::WebSocket::Frame->new($_[0]->rbuf);
 83 |                     is $frame->next,'server-send';
 84 | 
 85 |                     $cv->send;
 86 |                     undef $handle;
 87 |                 },
 88 |             );
 89 |         },
 90 |     );
 91 | 
 92 |     $cv->recv;
 93 | };
 94 | 
 95 | my $host = '127.0.0.1';
 96 | test_tcp(
 97 |     client => sub {
 98 |         my $port = shift;
 99 |         $client->($host, $port);
100 |     },
101 |     server => sub {
102 |         my $port = shift;
103 |         my $app    = MyApp::Web->to_app( );
104 |         my $twiggy = Twiggy::Server->new(
105 |             host => $host,
106 |             port => $port,
107 |         );
108 |         $twiggy->register_service($app);
109 | 
110 |         AE::cv->recv;
111 |     },
112 | );
113 | 
114 | done_testing;
115 | 


--------------------------------------------------------------------------------
/t/600_plugins/014_streaming_header_splitting.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | use Plack::Util;
 5 | use Plack::Test;
 6 | use Test::More;
 7 | use HTTP::Request::Common;
 8 | use Test::Requires 'Test::WWW::Mechanize::PSGI';
 9 | $Plack::Test::Impl = "Server";
10 | 
11 | use Amon2;
12 | 
13 | {
14 |     package MyApp::Web;
15 |     use parent -norequire, qw/MyApp/;
16 |     use parent qw/Amon2::Web/;
17 |     sub dispatch {
18 |         my $c = shift;
19 |         $c->streaming(sub {
20 |             my ($respond) = @_;
21 |             my $writer = $respond->(
22 |                 [200, ['Content-Type', "text/html\015\012hogehoge"]]);
23 |             $writer->write("\n");
24 |             for my $i (1..5) {
25 |                 $writer->write("
$i
\n");
26 |             }
27 |             $writer->write("\n");
28 |             $writer->close;
29 |         });
30 |     }
31 | }
32 | 
33 | {
34 |     package MyApp;
35 |     use parent qw/Amon2/;
36 |     __PACKAGE__->load_plugin('Amon2::Plugin::Web::Streaming');
37 | }
38 | 
39 | my $app = MyApp::Web->to_app();
40 | 
41 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
42 | my $res = $mech->get('/');
43 | like $res->code, qr/\A5\d\d\z/;
44 | unlike $res->content, qr//;
45 | 
46 | done_testing;
47 | 


--------------------------------------------------------------------------------
/t/800_dispatcher/002_router_simple.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'Test::WWW::Mechanize::PSGI', 'Router::Simple';
 5 | 
 6 | {
 7 |     package MyApp;
 8 |     use parent qw/Amon2/;
 9 | 	__PACKAGE__->make_local_context();
10 | }
11 | 
12 | {
13 |     package MyApp::Web;
14 |     use parent -norequire, qw/MyApp/;
15 |     use parent qw/Amon2::Web/;
16 |     sub dispatch { MyApp::Web::Dispatcher->dispatch(shift) }
17 | }
18 | 
19 | {
20 |     package MyApp::Web::C::My;
21 |     sub foo { $_[1]->create_response(200, [], 'foo') }
22 | 
23 |     package MyApp::Web::C::Bar;
24 |     sub poo { $_[1]->create_response(200, [], 'poo') }
25 | 
26 |     package MyApp::Web::C::Root;
27 |     sub index { $_[1]->create_response(200, [], 'top') }
28 | 
29 |     package MyApp::Web::C::Blog;
30 |     sub monthly {
31 |         my ($class, $c, $args) = @_;
32 |         $c->create_response(200, [], "blog: $args->{year}, $args->{month}")
33 |     }
34 | 
35 |     package MyApp::Web::C::Account;
36 |     use strict;
37 |     use warnings;
38 |     sub login { $_[1]->create_response(200, [], 'login') }
39 | 
40 |     package MyApp::Web::Dispatcher;
41 |     use Amon2::Web::Dispatcher::RouterSimple;
42 | 
43 |     ::isa_ok __PACKAGE__->router(), 'Router::Simple';
44 | 
45 |     connect '/', {controller => 'Root', action => 'index'};
46 |     connect '/my/foo', 'My#foo';
47 |     connect '/bar/:action', 'Bar';
48 |     connect '/blog/{year}/{month}', {controller => 'Blog', action => 'monthly'};
49 |     submapper('/account/', {controller => 'Account'})
50 |         ->connect('login', {action => 'login'});
51 | }
52 | 
53 | my $app = MyApp::Web->to_app();
54 | 
55 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
56 | $mech->get_ok('/');
57 | $mech->content_is('top');
58 | $mech->get_ok('/my/foo');
59 | $mech->content_is('foo');
60 | $mech->get_ok('/bar/poo');
61 | $mech->content_is('poo');
62 | $mech->get_ok('/blog/2010/04');
63 | $mech->content_is("blog: 2010, 04");
64 | $mech->get_ok('/account/login');
65 | $mech->content_is("login");
66 | 
67 | done_testing;
68 | 
69 | 


--------------------------------------------------------------------------------
/t/800_dispatcher/003_lite.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More tests => 4;
 4 | use Test::Requires 'Router::Simple', 'Router::Simple::Sinatraish';
 5 | 
 6 | {
 7 |     package MyApp;
 8 |     use parent qw/Amon2/;
 9 | 
10 |     package MyApp::V::MT;
11 | 
12 |     package MyApp::Web;
13 |     use parent -norequire, qw/MyApp/;
14 |     use parent qw/Amon2::Web/;
15 |     sub dispatch { MyApp::Web::Dispatcher->dispatch(shift) }
16 | 
17 |     package MyApp::Web::Dispatcher;
18 |     use Amon2::Web::Dispatcher::Lite '-base';
19 | 
20 |     get '/' => sub {
21 |         my $c = shift;
22 |         $c->create_response(200, [], 'ok')
23 |     };
24 |     get '/hello/:name' => sub {
25 |         my ($c, $args) = @_;
26 |         $c->create_response(200, [], ["hi, $args->{name}"])
27 |     };
28 |     post '/new' => sub {
29 |         my ($c, $args) = @_;
30 |         $c->create_response(200, [], ["post"])
31 |     };
32 | }
33 | 
34 | my $app = MyApp::Web->to_app();
35 | {
36 |     my $ret = $app->({
37 |         PATH_INFO      => '/',
38 |         REQUEST_METHOD => 'GET',
39 |     });
40 |     is $ret->[2]->[0], 'ok';
41 | }
42 | {
43 |     my $ret = $app->({
44 |         PATH_INFO      => '/hello/tokuhirom',
45 |         REQUEST_METHOD => 'GET',
46 |     });
47 |     is $ret->[2]->[0], 'hi, tokuhirom';
48 | }
49 | {
50 |     my $ret = $app->({
51 |         PATH_INFO      => '/hello/tokuhirom',
52 |         REQUEST_METHOD => 'POST',
53 |     });
54 |     is $ret->[0], 405, 'Method not allowed';
55 | }
56 | {
57 |     my $ret = $app->({
58 |         PATH_INFO      => '/new',
59 |         REQUEST_METHOD => 'POST',
60 |     });
61 |     is $ret->[2]->[0], 'post';
62 | }
63 | 
64 | 


--------------------------------------------------------------------------------
/t/800_dispatcher/004_router_boom.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'Test::WWW::Mechanize::PSGI';
 5 | 
 6 | {
 7 |     package MyApp;
 8 |     use parent qw/Amon2/;
 9 | }
10 | 
11 | {
12 |     package MyApp::Web;
13 |     use parent -norequire, qw/MyApp/;
14 |     use parent qw/Amon2::Web/;
15 |     sub dispatch { MyApp::Web::Dispatcher->dispatch(shift) }
16 | }
17 | 
18 | {
19 |     package MyApp::Web::C::My;
20 |     sub foo { Amon2->context->create_response(200, [], 'foo') }
21 | 
22 |     package MyApp::Web::C::Root;
23 |     sub index { Amon2->context->create_response(200, [], 'top') }
24 |     sub post_index { Amon2->context->create_response(200, [], 'post_top') }
25 |     sub put_index { Amon2->context->create_response(200, [], 'put_top') }
26 |     sub remove_index { Amon2->context->create_response(200, [], 'remove_top') }
27 | 
28 |     package MyApp::Web::C::Blog;
29 |     sub monthly {
30 |         my ($class, $c, $args) = @_;
31 |         Amon2->context->create_response(200, [], "blog: $args->{year}, $args->{month}")
32 |     }
33 | 
34 |     package MyApp::Web::C::Account;
35 |     use strict;
36 |     use warnings;
37 |     sub login { $_[1]->create_response(200, [], 'login') }
38 | 
39 |     package MyApp::Web::Dispatcher;
40 |     use Amon2::Web::Dispatcher::RouterBoom;
41 | 
42 |     ::isa_ok __PACKAGE__->router(), 'Router::Boom::Method';
43 | 
44 |     base 'MyApp::Web::C';
45 | 
46 |     get '/',        'Root#index';
47 |     post '/',        'Root#post_index';
48 |     put '/',        'Root#put_index';
49 |     delete_ '/',        'Root#remove_index';
50 |     get '/my/foo', 'My#foo';
51 |     get '/blog/{year}/{month}', 'Blog#monthly';
52 |     get '/account/login', 'Account#login';
53 | }
54 | 
55 | my $app = MyApp::Web->to_app();
56 | 
57 | sub Test::WWW::Mechanize::PSGI::delete_ok {
58 |     my ($self, $url) = @_;
59 |     my $request = HTTP::Request->new(DELETE => $url);
60 |     my $res = $self->request($request);
61 |     ::ok($res->code =~ /\A2..\z/, "DELETE $url");
62 | }
63 | 
64 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
65 | $mech->get_ok('/');
66 | $mech->content_is('top');
67 | $mech->post_ok('/');
68 | $mech->content_is('post_top');
69 | $mech->put_ok('/');
70 | $mech->content_is('put_top');
71 | $mech->delete_ok('/');
72 | $mech->content_is('remove_top');
73 | $mech->get_ok('/my/foo');
74 | $mech->content_is('foo');
75 | $mech->get_ok('/blog/2010/04');
76 | $mech->content_is("blog: 2010, 04");
77 | $mech->get_ok('/account/login');
78 | $mech->content_is("login");
79 | 
80 | done_testing;
81 | 
82 | 


--------------------------------------------------------------------------------
/t/800_dispatcher/004_router_boom_sinatraish.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | use Test::Requires 'Test::WWW::Mechanize::PSGI';
 5 | 
 6 | {
 7 |     package MyApp;
 8 |     use parent qw/Amon2/;
 9 | }
10 | 
11 | {
12 |     package MyApp::Web;
13 |     use parent -norequire, qw/MyApp/;
14 |     use parent qw/Amon2::Web/;
15 |     sub dispatch { MyApp::Web::Dispatcher->dispatch(shift) }
16 | }
17 | 
18 | {
19 |     package MyApp::Web::C::My;
20 |     sub foo { Amon2->context->create_response(200, [], 'foo') }
21 | 
22 |     package MyApp::Web::C::Root;
23 |     sub index { Amon2->context->create_response(200, [], 'top') }
24 |     sub post_index { Amon2->context->create_response(200, [], 'post_top') }
25 | 
26 |     package MyApp::Web::C::Blog;
27 |     sub monthly {
28 |         my ($class, $c, $args) = @_;
29 |         Amon2->context->create_response(200, [], "blog: $args->{year}, $args->{month}")
30 |     }
31 | 
32 |     package MyApp::Web::C::Account;
33 |     use strict;
34 |     use warnings;
35 |     sub login { $_[1]->create_response(200, [], 'login') }
36 | 
37 |     package MyApp::Web::Dispatcher;
38 |     use Amon2::Web::Dispatcher::RouterBoom;
39 | 
40 |     ::isa_ok __PACKAGE__->router(), 'Router::Boom::Method';
41 | 
42 |     get '/', sub { $_[0]->create_response(200, [], 'top') };
43 |     post '/', sub { $_[0]->create_response(200, [], 'post_top') };
44 |     put '/', sub { $_[0]->create_response(200, [], 'put_top') };
45 |     delete_ '/', sub { $_[0]->create_response(200, [], 'delete_top') };
46 |     get '/my/foo', sub { $_[0]->create_response(200, [], 'foo') };
47 |     get '/blog/{year}/{month}', sub {
48 |         my ($c, $captured) = @_;
49 |         $c->create_response(200, [], "blog: $captured->{year}, $captured->{month}")
50 |     };
51 |     get '/account/login', sub {
52 |         my ($c, $captured) = @_;
53 |         $c->create_response(200, [], 'login');
54 |     };
55 | }
56 | 
57 | sub Test::WWW::Mechanize::PSGI::delete_ok {
58 |     my ($self, $url) = @_;
59 |     my $request = HTTP::Request->new(DELETE => $url);
60 |     my $res = $self->request($request);
61 |     ::ok($res->code =~ /\A2..\z/, "DELETE $url");
62 | }
63 | 
64 | my $app = MyApp::Web->to_app();
65 | 
66 | my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
67 | $mech->get_ok('/');
68 | $mech->content_is('top');
69 | $mech->head_ok('/');
70 | $mech->post_ok('/');
71 | $mech->content_is('post_top');
72 | $mech->put_ok('/');
73 | $mech->content_is('put_top');
74 | $mech->delete_ok('/');
75 | $mech->content_is('delete_top');
76 | $mech->get_ok('/my/foo');
77 | $mech->content_is('foo');
78 | $mech->get_ok('/blog/2010/04');
79 | $mech->content_is("blog: 2010, 04");
80 | $mech->get_ok('/account/login');
81 | $mech->content_is("login");
82 | 
83 | done_testing;
84 | 
85 | 


--------------------------------------------------------------------------------
/t/TestFlavor.pm:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use utf8;
 4 | 
 5 | package t::TestFlavor;
 6 | use parent qw(Exporter);
 7 | our @EXPORT = qw(test_flavor);
 8 | use File::Temp qw/tempdir/;
 9 | use App::Prove;
10 | use File::Basename;
11 | use Cwd;
12 | use File::Spec;
13 | use Plack::Util;
14 | use Test::More;
15 | 
16 | sub test_flavor {
17 |     my ($code, $flavor) = @_;
18 | 
19 | 	local $ENV{PLACK_ENV} = 'development';
20 |     $flavor = Plack::Util::load_class($flavor, 'Amon2::Setup::Flavor');
21 | 
22 |     my $libpath = File::Spec->rel2abs(File::Spec->catfile(dirname(__FILE__), '..', 'lib'));
23 |     unshift @INC, $libpath;
24 | 
25 |     my $dir = tempdir(CLEANUP => $ENV{DEBUG} ? 0 : 1);
26 |     my $cwd = Cwd::getcwd();
27 |     chdir($dir);
28 |     unshift @INC, "$dir/lib";
29 |     note $dir;
30 | 
31 |     {
32 |         $flavor->new(module => 'My::App')->run;
33 |         $code->($flavor);
34 | 
35 |         # run prove
36 |         my $app = App::Prove->new();
37 |         $app->process_args('--norc', '--exec', "$^X -I. -Ilib -Mlib=$libpath", );
38 |         ok($app->run);
39 |     }
40 | 
41 |     note $dir;
42 | 
43 |     chdir($cwd);
44 | }
45 | 
46 | 1;
47 | 
48 | 


--------------------------------------------------------------------------------
/t/Util.pm:
--------------------------------------------------------------------------------
 1 | package t::Util;
 2 | use strict;
 3 | use warnings;
 4 | use base qw/Exporter/;
 5 | use File::Spec;
 6 | use FindBin;
 7 | use File::Basename;
 8 | use File::Spec;
 9 | use Test::More;
10 | use App::Prove;
11 | use File::Basename;
12 | 
13 | our @EXPORT = qw/run_app_test slurp/;
14 | 
15 | sub run_app_test {
16 |     my $name = shift;
17 | 
18 |     my $libpath = File::Spec->rel2abs(File::Spec->catfile(dirname(__FILE__), '..', 'lib'));
19 | 
20 |     chdir "eg/apps/$name/" or die $!;
21 | 
22 |     my $app = App::Prove->new();
23 |     $app->process_args('--norc', '-I.', '-Ilib', "-I$libpath", );
24 |     ok($app->run, 'all tests ok');
25 |     done_testing;
26 | }
27 | 
28 | sub slurp {
29 | 	my $fname = shift;
30 | 	open my $fh, '<', $fname or die "$fname: $!";
31 | 	do { local $/; <$fh> };
32 | }
33 | 
34 | 1;
35 | 


--------------------------------------------------------------------------------
/t/tmpl/foo.mt:
--------------------------------------------------------------------------------
1 | Hello, !
2 | 


--------------------------------------------------------------------------------
/xt/02_perlcritic.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use Test::More;
 4 | 
 5 | eval {
 6 |     require Perl::Critic;
 7 |     Perl::Critic->VERSION(1.105);
 8 | 
 9 |     require Test::Perl::Critic;
10 |     Test::Perl::Critic->VERSION(1.02);
11 |     Test::Perl::Critic->import(
12 |         -profile => \(join q{}, )
13 |     );
14 | };
15 | note $@ if $@;
16 | plan skip_all => "Perl::Critic 1.105+ or Test::Perl::Critic 1.02+ is not installed." if $@;
17 | 
18 | all_critic_ok('lib', 'script', 'bin');
19 | 
20 | __END__
21 | 
22 | only=1
23 | 
24 | # -------------------------------------------------------------------------
25 | # Not important.
26 | 
27 | [BuiltinFunctions::ProhibitSleepViaSelect]
28 | [BuiltinFunctions::RequireGlobFunction]
29 | [ClassHierarchies::ProhibitOneArgBless]
30 | 
31 | # -------------------------------------------------------------------------
32 | # Bug detection
33 | [InputOutput::ProhibitBarewordFileHandles]
34 | [Modules::RequireFilenameMatchesPackage]
35 | [Subroutines::ProhibitNestedSubs]
36 | [Subroutines::ProhibitReturnSort]
37 | [TestingAndDebugging::RequireUseStrict]
38 | [Variables::ProhibitConditionalDeclarations]
39 | [Variables::RequireLexicalLoopIterators]
40 | 
41 | [TestingAndDebugging::ProhibitNoStrict]
42 | allow=refs
43 | 
44 | # -------------------------------------------------------------------------
45 | # Security issue detection
46 | [InputOutput::RequireEncodingWithUTF8Layer]
47 | [Modules::ProhibitEvilModules]
48 | [InputOutput::ProhibitTwoArgOpen]
49 | 
50 | 


--------------------------------------------------------------------------------
/xt/06_dependencies.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 |  
 4 | use Test::More 0.98;
 5 | 
 6 | BEGIN {
 7 |     plan skip_all => "AUTHOR_TESTING is required." unless $ENV{AUTHOR_TESTING};
 8 | }
 9 | 
10 | use File::Which;
11 | use File::Temp qw(tempdir);
12 | 
13 | plan skip_all => "No cpanm" unless which('cpanm');
14 | 
15 | local $ENV{PERL_CPANM_OPT} = '--no-man-pages --no-prompt --no-interactive';
16 | 
17 | my $tmp = tempdir(CLEANUP => 1);
18 | is(system("cpanm --notest -l $tmp ."), 0);
19 | for (qw(Amon2::Lite Amon2::Auth Amon2::DBI Amon2::MobileJP Amon2::Plugin::L10N)) {
20 |     is(system("cpanm -l $tmp --reinstall $_"), 0, $_);
21 | }
22 | 
23 | done_testing;
24 | 


--------------------------------------------------------------------------------
/xt/skelton/01_basic.t:
--------------------------------------------------------------------------------
 1 | use strict;
 2 | use warnings;
 3 | use File::Temp qw/tempdir/;
 4 | use FindBin;
 5 | use File::Spec;
 6 | use lib File::Spec->catfile($FindBin::Bin, '..', 'lib');
 7 | use Plack::Util;
 8 | use Plack::Test;
 9 | use Cwd;
10 | use Test::More;
11 | use App::Prove;
12 | use Test::Requires 'HTML::FillInForm::Lite', 'Plack::Middleware::ReverseProxy', 'Amon2::DBI', 'DBD::SQLite';
13 | use Test::Requires {
14 |     'Crypt::Rijndael' => 0,
15 | };
16 | use Config;
17 | 
18 | &main; done_testing; exit;
19 | 
20 | sub main {
21 |     my $old_cwd = Cwd::cwd;
22 | 		local $ENV{PLACK_ENV} = 'development';
23 |         &main_test;
24 |     chdir $old_cwd;
25 | }
26 | 
27 | sub main_test {
28 |     my $dir = tempdir(CLEANUP => 1);
29 |     chdir $dir or die $!;
30 |     unshift @INC, File::Spec->catfile($dir, 'Hello', 'lib');
31 | 
32 |     my $setup = File::Spec->catfile($FindBin::Bin, '..', '..', 'script', 'amon2-setup.pl');
33 |     my $libdir = File::Spec->catfile($FindBin::Bin, '..', '..', 'lib');
34 |     !system $^X, '-I', $libdir, $setup, 'Hello' or die $!;
35 |     chdir 'Hello' or die $!;
36 | 
37 |     note '-- run prove';
38 |     system "$^X Build.PL";
39 |     system './Build';
40 |     my $app = App::Prove->new();
41 |     $app->process_args('--norc', '--exec', "$^X -I. -Ilib -I".File::Spec->catfile($FindBin::Bin, '..', '..', 'lib'), , );
42 |     ok($app->run);
43 | }
44 | 


--------------------------------------------------------------------------------