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,39 @@
+use strict;
+use warnings;
+use Module::Build;
+use Module::CPANfile;
+use builder::MyBuilder;
+
+my $file = Module::CPANfile->load("cpanfile");
+my $prereq = $file->prereq_specs;
+
+my $build = builder::MyBuilder->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}},
+    },
+    script_files => [glob('script/*'), glob('bin/*')],
+
+    no_index    => { 'directory' => [ 'inc' ] },
+    name        => 'OAuth1TokenVendingServer',
+    module_name => 'OAuth1TokenVendingServer',
+    author        => 'Some Person <person@example.com>',
+    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();

builder/MyBuilder.pm

@@ -0,0 +1,26 @@
+package builder::MyBuilder;
+use strict;
+use warnings;
+use utf8;
+use 5.008_001;
+use parent qw(Module::Build);
+
+# Module:::Build's share_dir handling is not good for me.
+# We need to install 'tmpl' directories to '$DIST_DIR/tmpl'. But M::B doesn't support it.
+sub ACTION_code {
+    my $self = shift;
+    my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share dist/, 'OAuth1TokenVendingServer');
+    for my $dir (qw(tmpl static)) {
+        next unless -d $dir;
+        for my $src (@{$self->rscan_dir($dir)}) {
+            next if -d $src;
+            $self->copy_if_modified(
+                from => $src,
+                to_dir => File::Spec->catfile( $share_prefix )
+            );
+        }
+    }
+    $self->SUPER::ACTION_code();
+}
+
+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/production.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', 'production.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,23 @@
+requires 'Amon2', '6.02';
+requires 'DBD::SQLite', '1.33';
+requires 'HTML::FillInForm::Lite', '1.11';
+requires 'HTTP::Session2', '0.04';
+requires 'JSON', '2.50';
+requires 'Module::Functions', '2';
+requires 'Plack::Middleware::ReverseProxy', '0.09';
+requires 'Router::Boom', '0.06';
+requires 'Starlet', '0.20';
+requires 'Teng', '0.18';
+requires 'Test::WWW::Mechanize::PSGI';
+requires 'Text::Xslate', '2.0009';
+requires 'Time::Piece', '1.20';
+requires 'perl', '5.010_001';
+
+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/OAuth1TokenVendingServer.pm

@@ -0,0 +1,47 @@
+package OAuth1TokenVendingServer;
+use strict;
+use warnings;
+use utf8;
+our $VERSION='0.01';
+use 5.008001;
+use OAuth1TokenVendingServer::DB::Schema;
+use OAuth1TokenVendingServer::DB;
+
+use parent qw/Amon2/;
+# Enable project local mode.
+__PACKAGE__->make_local_context();
+
+my $schema = OAuth1TokenVendingServer::DB::Schema->instance;
+
+sub db {
+    my $c = shift;
+    if (!exists $c->{db}) {
+        my $conf = $c->config->{DBI}
+            or die "Missing configuration about DBI";
+        $c->{db} = OAuth1TokenVendingServer::DB->new(
+            schema       => $schema,
+            connect_info => [@$conf],
+            # I suggest to enable following lines if you are using mysql.
+            # on_connect_do => [
+            #     'SET SESSION sql_mode=STRICT_TRANS_TABLES;',
+            # ],
+        );
+    }
+    $c->{db};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+OAuth1TokenVendingServer - OAuth1TokenVendingServer
+
+=head1 DESCRIPTION
+
+This is a main context class for OAuth1TokenVendingServer
+
+=head1 AUTHOR
+
+OAuth1TokenVendingServer authors.
+

lib/OAuth1TokenVendingServer/DB.pm

@@ -0,0 +1,11 @@
+package OAuth1TokenVendingServer::DB;
+use strict;
+use warnings;
+use utf8;
+use parent qw(Teng);
+
+__PACKAGE__->load_plugin('Count');
+__PACKAGE__->load_plugin('Replace');
+__PACKAGE__->load_plugin('Pager');
+
+1;

lib/OAuth1TokenVendingServer/DB/Row.pm

@@ -0,0 +1,7 @@
+package OAuth1TokenVendingServer::DB::Row;
+use strict;
+use warnings;
+use utf8;
+use parent qw(Teng::Row);
+
+1;

lib/OAuth1TokenVendingServer/DB/Schema.pm

@@ -0,0 +1,16 @@
+package OAuth1TokenVendingServer::DB::Schema;
+use strict;
+use warnings;
+use utf8;
+
+use Teng::Schema::Declare;
+
+base_row_class 'OAuth1TokenVendingServer::DB::Row';
+
+table {
+    name 'member';
+    pk 'id';
+    columns qw(id name);
+};
+
+1;

lib/OAuth1TokenVendingServer/Web.pm

@@ -0,0 +1,48 @@
+package OAuth1TokenVendingServer::Web;
+use strict;
+use warnings;
+use utf8;
+use parent qw/OAuth1TokenVendingServer Amon2::Web/;
+use File::Spec;
+
+# dispatcher
+use OAuth1TokenVendingServer::Web::Dispatcher;
+sub dispatch {
+    return (OAuth1TokenVendingServer::Web::Dispatcher->dispatch($_[0]) or die "response is not generated");
+}
+
+# load plugins
+__PACKAGE__->load_plugins(
+    'Web::FillInFormLite',
+    'Web::JSON',
+    '+OAuth1TokenVendingServer::Web::Plugin::Session',
+);
+
+# setup view
+use OAuth1TokenVendingServer::Web::View;
+{
+    sub create_view {
+        my $view = OAuth1TokenVendingServer::Web::View->make_instance(__PACKAGE__);
+        no warnings 'redefine';
+        *OAuth1TokenVendingServer::Web::create_view = sub { $view }; # Class cache.
+        $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' );
+    },
+);
+
+1;

lib/OAuth1TokenVendingServer/Web/Dispatcher.pm

@@ -0,0 +1,29 @@
+package OAuth1TokenVendingServer::Web::Dispatcher;
+use strict;
+use warnings;
+use utf8;
+use Amon2::Web::Dispatcher::RouterBoom;
+
+any '/' => sub {
+    my ($c) = @_;
+    my $counter = $c->session->get('counter') || 0;
+    $counter++;
+    $c->session->set('counter' => $counter);
+    return $c->render('index.tx', {
+        counter => $counter,
+    });
+};
+
+post '/reset_counter' => sub {
+    my $c = shift;
+    $c->session->remove('counter');
+    return $c->redirect('/');
+};
+
+post '/account/logout' => sub {
+    my ($c) = @_;
+    $c->session->expire();
+    return $c->redirect('/');
+};
+
+1;

lib/OAuth1TokenVendingServer/Web/Plugin/Session.pm

@@ -0,0 +1,61 @@
+package OAuth1TokenVendingServer::Web::Plugin::Session;
+use strict;
+use warnings;
+use utf8;
+
+use Amon2::Util;
+use HTTP::Session2::ClientStore;
+
+sub init {
+    my ($class, $c) = @_;
+
+    # Validate XSRF Token.
+    $c->add_trigger(
+        BEFORE_DISPATCH => sub {
+            my ( $c ) = @_;
+            if ($c->req->method ne 'GET' && $c->req->method ne 'HEAD') {
+                my $token = $c->req->header('X-XSRF-TOKEN') || $c->req->param('XSRF-TOKEN');
+                unless ($c->session->validate_xsrf_token($token)) {
+                    return $c->create_simple_status_page(
+                        403, 'XSRF detected.'
+                    );
+                }
+            }
+            return;
+        },
+    );
+
+    Amon2::Util::add_method($c, 'session', \&_session);
+
+    # Inject cookie header after dispatching.
+    $c->add_trigger(
+        AFTER_DISPATCH => sub {
+            my ( $c, $res ) = @_;
+            if ($c->{session} && $res->can('cookies')) {
+                $c->{session}->finalize_plack_response($res);
+            }
+            return;
+        },
+    );
+}
+
+# $c->session() accessor.
+sub _session {
+    my $self = shift;
+
+    if (!exists $self->{session}) {
+        $self->{session} = HTTP::Session2::ClientStore->new(
+            env => $self->req->env,
+            secret => 'MkhNMylezxboeGQ0trSxqkN6BPpFjOGL',
+        );
+    }
+    return $self->{session};
+}
+
+1;
+__END__
+
+=head1 DESCRIPTION
+
+This module manages session for OAuth1TokenVendingServer.
+