initial import

.gitignore

@@ -0,0 +1,18 @@
+Makefile
+/inc/
+MANIFEST
+*.bak
+*.old
+nytprof.out
+nytprof/
+*.db
+/blib/
+pm_to_blib
+META.json
+META.yml
+MYMETA.json
+MYMETA.yml
+/Build
+/_build/
+/local/
+/.carton/

.proverc

@@ -0,0 +1,3 @@
+-l
+-r t
+-Mt::Util

Build.PL

@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+use Module::Build;
+use Module::CPANfile;
+
+my $file = Module::CPANfile->load("cpanfile");
+my $prereq = $file->prereq_specs;
+
+my $build = Module::Build->subclass(
+    code => q{
+        sub ACTION_install {
+            die "Do not install web application.\n";
+        }
+
+        # do not make blib.
+        sub ACTION_code {
+            my $self = shift;
+            $self->depends_on('config_data');
+        }
+
+        # run prove
+        sub ACTION_test {
+            my $self = shift;
+            my $tests = $self->find_test_files;
+
+            require App::Prove;
+            my $prove = App::Prove->new();
+            $prove->process_args('-l', @$tests);
+            $prove->run();
+        }
+    }
+)->new(
+    license              => 'unknown',
+    dynamic_config       => 0,
+
+    build_requires       => {
+        $prereq->{build} ? %{$prereq->{build}->{requires}} : (),
+        $prereq->{test} ? %{$prereq->{test}->{requires}} : (),
+    },
+    configure_requires   => {
+        %{$prereq->{configure}->{requires}},
+    },
+    requires             => {
+        perl => '5.008001',
+        %{$prereq->{runtime}->{requires}},
+    },
+
+    no_index    => { 'directory' => [ 'inc' ] },
+    name        => 'CPANasium',
+    module_name => 'CPANasium',
+    author        => 'Some Person <[email protected]>',
+    dist_abstract => 'A web site based on Amon2',
+
+    test_files => (-d '.git' || $ENV{RELEASE_TESTING}) ? 't/ xt/' : 't/',
+    recursive_test_files => 1,
+
+    create_readme  => 0,
+    create_license => 0,
+);
+$build->create_build_script();

app.psgi

@@ -0,0 +1,39 @@
+use strict;
+use utf8;
+use File::Spec;
+use File::Basename;
+use lib File::Spec->catdir(dirname(__FILE__), 'extlib', 'lib', 'perl5');
+use lib File::Spec->catdir(dirname(__FILE__), 'lib');
+use Plack::Builder;
+
+use CPANasium::Web;
+use CPANasium;
+use Plack::Session::Store::DBI;
+use Plack::Session::State::Cookie;
+use DBI;
+
+{
+    my $c = CPANasium->new();
+    $c->setup_schema();
+}
+my $db_config = CPANasium->config->{DBI} || die "Missing configuration for DBI";
+builder {
+    enable 'Plack::Middleware::Static',
+        path => qr{^(?:/static/)},
+        root => File::Spec->catdir(dirname(__FILE__));
+    enable 'Plack::Middleware::Static',
+        path => qr{^(?:/robots\.txt|/favicon\.ico)$},
+        root => File::Spec->catdir(dirname(__FILE__), 'static');
+    enable 'Plack::Middleware::ReverseProxy';
+    enable 'Plack::Middleware::Session',
+        store => Plack::Session::Store::DBI->new(
+            get_dbh => sub {
+                DBI->connect( @$db_config )
+                    or die $DBI::errstr;
+            }
+        ),
+        state => Plack::Session::State::Cookie->new(
+            httponly => 1,
+        );
+    CPANasium::Web->to_app();
+};

config/deployment.pl

@@ -0,0 +1,12 @@
+use File::Spec;
+use File::Basename qw(dirname);
+my $basedir = File::Spec->rel2abs(File::Spec->catdir(dirname(__FILE__), '..'));
+my $dbpath = File::Spec->catfile($basedir, 'db', 'deployment.db');
++{
+    'DBI' => [
+        "dbi:SQLite:dbname=$dbpath", '', '',
+        +{
+            sqlite_unicode => 1,
+        }
+    ],
+};

config/development.pl

@@ -0,0 +1,12 @@
+use File::Spec;
+use File::Basename qw(dirname);
+my $basedir = File::Spec->rel2abs(File::Spec->catdir(dirname(__FILE__), '..'));
+my $dbpath = File::Spec->catfile($basedir, 'db', 'development.db');
++{
+    'DBI' => [
+        "dbi:SQLite:dbname=$dbpath", '', '',
+        +{
+            sqlite_unicode => 1,
+        }
+    ],
+};

config/test.pl

@@ -0,0 +1,12 @@
+use File::Spec;
+use File::Basename qw(dirname);
+my $basedir = File::Spec->rel2abs(File::Spec->catdir(dirname(__FILE__), '..'));
+my $dbpath = File::Spec->catfile($basedir, 'db', 'test.db');
++{
+    'DBI' => [
+        "dbi:SQLite:dbname=$dbpath", '', '',
+        +{
+            sqlite_unicode => 1,
+        }
+    ],
+};

cpanfile

@@ -0,0 +1,21 @@
+requires 'Amon2'                           => '3.80';
+requires 'Text::Xslate'                    => '1.6001';
+requires 'Amon2::DBI'                      => '0.30';
+requires 'DBD::SQLite'                     => '1.33';
+requires 'HTML::FillInForm::Lite'          => '1.11';
+requires 'JSON'                            => '2.50';
+requires 'Module::Functions'               => '2';
+requires 'Plack::Middleware::ReverseProxy' => '0.09';
+requires 'Plack::Middleware::Session'      => '0';
+requires 'Plack::Session'                  => '0.14';
+requires 'Test::WWW::Mechanize::PSGI'      => '0';
+requires 'Time::Piece'                     => '1.20';
+
+on 'configure' => sub {
+   requires 'Module::Build'     => '0.38';
+   requires 'Module::CPANfile' => '0.9010';
+};
+
+on 'test' => sub {
+   requires 'Test::More'     => '0.98';
+};

db/.gitignore

@@ -0,0 +1,2 @@
+*
+!.gitignore

lib/CPANasium.pm

@@ -0,0 +1,26 @@
+package CPANasium;
+use strict;
+use warnings;
+use utf8;
+use parent qw/Amon2/;
+our $VERSION='0.01';
+use 5.008001;
+
+__PACKAGE__->load_plugin(qw/DBI/);
+
+# initialize database
+use DBI;
+sub setup_schema {
+    my $self = shift;
+    my $dbh = $self->dbh();
+    my $driver_name = $dbh->{Driver}->{Name};
+    my $fname = lc("sql/${driver_name}.sql");
+    open my $fh, '<:encoding(UTF-8)', $fname or die "$fname: $!";
+    my $source = do { local $/; <$fh> };
+    for my $stmt (split /;/, $source) {
+        next unless $stmt =~ /\S/;
+        $dbh->do($stmt) or die $dbh->errstr();
+    }
+}
+
+1;

lib/CPANasium/Web.pm

@@ -0,0 +1,53 @@
+package CPANasium::Web;
+use strict;
+use warnings;
+use utf8;
+use parent qw/CPANasium Amon2::Web/;
+use File::Spec;
+
+# dispatcher
+use CPANasium::Web::Dispatcher;
+sub dispatch {
+    return (CPANasium::Web::Dispatcher->dispatch($_[0]) or die "response is not generated");
+}
+
+# load plugins
+__PACKAGE__->load_plugins(
+    'Web::FillInFormLite',
+    'Web::CSRFDefender' => {
+        post_only => 1,
+    },
+);
+
+# setup view
+use CPANasium::Web::View;
+{
+    my $view = CPANasium::Web::View->make_instance(__PACKAGE__);
+    sub create_view { $view }
+}
+
+# for your security
+__PACKAGE__->add_trigger(
+    AFTER_DISPATCH => sub {
+        my ( $c, $res ) = @_;
+
+        # http://blogs.msdn.com/b/ie/archive/2008/07/02/ie8-security-part-v-comprehensive-protection.aspx
+        $res->header( 'X-Content-Type-Options' => 'nosniff' );
+
+        # http://blog.mozilla.com/security/2010/09/08/x-frame-options/
+        $res->header( 'X-Frame-Options' => 'DENY' );
+
+        # Cache control.
+        $res->header( 'Cache-Control' => 'private' );
+    },
+);
+
+__PACKAGE__->add_trigger(
+    BEFORE_DISPATCH => sub {
+        my ( $c ) = @_;
+        # ...
+        return;
+    },
+);
+
+1;

lib/CPANasium/Web/Dispatcher.pm

@@ -0,0 +1,18 @@
+package CPANasium::Web::Dispatcher;
+use strict;
+use warnings;
+use utf8;
+use Amon2::Web::Dispatcher::Lite;
+
+any '/' => sub {
+    my ($c) = @_;
+    return $c->render('index.tt');
+};
+
+post '/account/logout' => sub {
+    my ($c) = @_;
+    $c->session->expire();
+    return $c->redirect('/');
+};
+
+1;

lib/CPANasium/Web/View.pm

@@ -0,0 +1,38 @@
+package CPANasium::Web::View;
+use strict;
+use warnings;
+use utf8;
+use Carp ();
+use File::Spec ();
+
+use Text::Xslate 1.6001;
+use CPANasium::Web::ViewFunctions;
+
+# setup view class
+sub make_instance {
+    my ($class, $context) = @_;
+    Carp::croak("Usage: CPANasium::View->make_instance(\$context_class)") if @_!=2;
+
+    my $view_conf = $context->config->{'Text::Xslate'} || +{};
+    unless (exists $view_conf->{path}) {
+        $view_conf->{path} = [ File::Spec->catdir($context->base_dir(), 'tmpl') ];
+    }
+    my $view = Text::Xslate->new(+{
+        'syntax'   => 'TTerse',
+        'module'   => [
+            'Text::Xslate::Bridge::Star',
+            'CPANasium::Web::ViewFunctions',
+        ],
+        'function' => {
+        },
+        ($context->debug_mode ? ( warn_handler => sub {
+            Text::Xslate->print( # print method escape html automatically
+                '[[', @_, ']]',
+            );
+        } ) : () ),
+        %$view_conf
+    });
+    return $view;
+}
+
+1;

lib/CPANasium/Web/ViewFunctions.pm

@@ -0,0 +1,38 @@
+package CPANasium::Web::ViewFunctions;
+use strict;
+use warnings;
+use utf8;
+use parent qw(Exporter);
+use Module::Functions;
+use File::Spec;
+
+our @EXPORT = get_public_functions();
+
+sub commify {
+    local $_  = shift;
+    1 while s/((?:\A|[^.0-9])[-+]?\d+)(\d{3})/$1,$2/s;
+    return $_;
+}
+
+sub c { Amon2->context() }
+sub uri_with { Amon2->context()->req->uri_with(@_) }
+sub uri_for { Amon2->context()->uri_for(@_) }
+
+{
+    my %static_file_cache;
+    sub static_file {
+        my $fname = shift;
+        my $c = Amon2->context;
+        if (not exists $static_file_cache{$fname}) {
+            my $fullpath = File::Spec->catfile($c->base_dir(), $fname);
+            $static_file_cache{$fname} = (stat $fullpath)[9];
+        }
+        return $c->uri_for(
+            $fname, {
+                't' => $static_file_cache{$fname} || 0
+            }
+        );
+    }
+}
+
+1;

sql/mysql.sql

@@ -0,0 +1,4 @@
+CREATE TABLE IF NOT EXISTS sessions (
+    id           CHAR(72) PRIMARY KEY,
+    session_data TEXT
+);

sql/sqlite.sql

@@ -0,0 +1,4 @@
+CREATE TABLE IF NOT EXISTS sessions (
+    id           CHAR(72) PRIMARY KEY,
+    session_data TEXT
+);