Permalink
Browse files

initial import

  • Loading branch information...
0 parents commit dfc5a98d6224fed385ca94b92c348552c7592542 @kentaro committed May 1, 2011
@@ -0,0 +1 @@
+environments/*.yml
@@ -0,0 +1,22 @@
+MANIFEST
+bin/app.pl
+config.yml
+environments/development.yml
+environments/production.yml
+views/index.tt
+views/layouts/main.tt
+MANIFEST.SKIP
+lib/Dotcloud/Kentaro.pm
+public/css/style.css
+public/css/error.css
+public/images/perldancer-bg.jpg
+public/images/perldancer.jpg
+public/500.html
+public/404.html
+public/dispatch.fcgi
+public/favicon.ico
+public/dispatch.cgi
+public/javascripts/jquery.js
+t/002_index_route.t
+t/001_base.t
+Makefile.PL
@@ -0,0 +1,13 @@
+^\.git\/
+maint
+^tags$
+.last_cover_stats
+Makefile$
+^blib
+^pm_to_blib
+^.*.bak
+^.*.old
+^t.*sessions
+^cover_db
+^.*\.log
+^.*\.swp$
@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Dotcloud::Kentaro',
+ AUTHOR => 'Kentaro Kuribayashi',
+ VERSION_FROM => 'lib/Dotcloud/Kentaro.pm',
+
+ ($ExtUtils::MakeMaker::VERSION >= 6.3002
+ ? ('LICENSE'=> 'MIT')
+ : ()),
+
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0.96,
+ 'YAML' => 0,
+ 'JSON::XS' => 2.3,
+ 'UNIVERSAL::require' => 0,
+ 'Template' => 0,
+ 'Dancer' => 1.3030,
+ 'Dancer::Session::Cookie' => 0,
+ 'Dancer::Plugin::Auth::Twitter' => 0,
+ 'LWP::Protocol::https' => 6.02,
+ 'Plack::Request' => 0,
+ 'Mouse' => 0.92,
+ 'Redis' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Dotcloud-Kentaro-*' },
+);
@@ -0,0 +1,5 @@
+#!/usr/bin/env perl
+use Dancer;
+use Dotcloud::Kentaro;
+
+dance;
@@ -0,0 +1,28 @@
+# This is the main configuration file of your Dancer app
+# env-related settings should go to environments/$env.yml
+# all the settings in this file will be loaded at Dancer's startup.
+
+# Your application's name
+appname: "Dotcloud::Kentaro"
+
+# The default layout to use for your application (located in
+# views/layouts/main.tt)
+layout: "main"
+
+# when the charset is set to UTF-8 Dancer will handle for you
+# all the magic of encoding and decoding. You should not care
+# about unicode within your app when this setting is set (recommended).
+charset: "UTF-8"
+
+# template engine
+# simple: default and very basic template engine
+# template_toolkit: TT
+
+# template: "simple"
+
+template: "template_toolkit"
+engines:
+ template_toolkit:
+ encoding: 'utf8'
+ start_tag: '[%'
+ end_tag: '%]'
16 daiku
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Daiku;
+
+task deploy => [qw(push symlink)];
+
+task push => sub {
+ system qw(dotcloud push kentaro.now .)
+};
+
+task symlink => sub {
+ system qw(dotcloud run kentaro.now -- cd code/.; ln -s ../../etc/kentaro.now/deployment.yml environments/deployment.yml)
+};
+
+build shift @ARGV || 'deploy';
No changes.
@@ -0,0 +1,36 @@
+package Dotcloud::Kentaro;
+use Dancer ':syntax';
+use Dancer::Plugin::Auth::Twitter;
+
+our $VERSION = '0.01';
+
+use Dotcloud::Kentaro::App::Now;
+
+auth_twitter_init;
+
+get '/' => sub {
+ my $app = Dotcloud::Kentaro::App::Now->new(
+ user => session('twitter_user'),
+ twitter_url => !session('twitter_user') ? auth_twitter_authenticate_url : undef,
+ );
+
+ template 'index', { app => $app };
+};
+
+post '/' => sub {
+ my $app = Dotcloud::Kentaro::App::Now->new(
+ user => session('twitter_user'),
+ );
+
+ if ($app->create(
+ now => params->{now},
+ user => session('twitter_user'),
+ )) {
+ redirect '/';
+ }
+ else {
+ template 'index', { app => $app };
+ }
+};
+
+true;
@@ -0,0 +1,6 @@
+package Dotcloud::Kentaro::App;
+use Mouse;
+no Mouse;
+__PACKAGE__->meta->make_immutable;
+
+!!1;
@@ -0,0 +1,53 @@
+package Dotcloud::Kentaro::App::Now;
+use Mouse;
+extends 'Dotcloud::Kentaro::App';
+
+has 'user' => (
+ is => 'rw',
+ isa => 'Maybe[HashRef]'
+);
+
+has 'twitter_url' => (
+ is => 'rw',
+ isa => 'Maybe[Object]',
+);
+
+has 'error' => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 0,
+);
+
+no Mouse;
+__PACKAGE__->meta->make_immutable;
+
+use Dotcloud::Kentaro::Model::Now;
+
+sub entries {
+ my ($self, $offset, $limit) = @_;
+ my $model = Dotcloud::Kentaro::Model::Now->new;
+ $model->retrieve(
+ offset => $offset,
+ limit => $limit,
+ );
+}
+
+sub create {
+ my ($self, %args) = @_;
+
+ return if !$self->user;
+
+ # 超適当なのでちゃんとバリデーションしましょう
+ if (!$args{now} || length $args{now} > 30) {
+ $self->error(1);
+ return;
+ }
+ else {
+ my $model = Dotcloud::Kentaro::Model::Now->new;
+ $model->create(%args);
+ }
+
+ 1;
+}
+
+!!1;
@@ -0,0 +1,11 @@
+package Dotcloud::Kentaro::Model;
+use Mouse::Role;
+
+requires qw(
+ create
+ retrieve
+ update
+ delete
+);
+
+!!1;
@@ -0,0 +1,39 @@
+package Dotcloud::Kentaro::Model::Now;
+use Mouse;
+with qw(Dotcloud::Kentaro::Model);
+
+has 'table' => (
+ is => 'rw',
+ isa => 'Str',
+ default => 'now',
+);
+
+has 'storage' => (
+ is => 'rw',
+ default => sub {
+ Dotcloud::Kentaro::Storage::Redis->use;
+ Dotcloud::Kentaro::Storage::Redis->new;
+ },
+ lazy => 1,
+);
+
+no Mouse;
+__PACKAGE__->meta->make_immutable;
+
+use UNIVERSAL::require;
+
+sub create {
+ my ($self, %args) = @_;
+ $self->storage->create(table => $self->table, %args);
+}
+
+sub retrieve {
+ my ($self, %args) = @_;
+ $self->storage->retrieve(table => $self->table, %args);
+}
+
+sub update {}
+
+sub delete {}
+
+!!1;
@@ -0,0 +1,11 @@
+package Dotcloud::Kentaro::Stroge;
+use Mouse::Role;
+
+requires qw(
+ create
+ retrive
+ update
+ delete
+);
+
+!!1;
@@ -0,0 +1,43 @@
+package Dotcloud::Kentaro::Storage::Redis;
+use Mouse;
+with qw(Dotcloud::Kentaro::Storage);
+
+no Mouse;
+__PACKAGE__->meta->make_immutable;
+
+use Redis;
+use JSON::XS ();
+use Dancer ':syntax';
+
+sub redis {
+ # ここでおもむろにDancerのconfig使うのよくないのでちゃんとするべき
+ my $redis = Redis->new(%{config->{redis}});
+
+ if (config->{redis}{password}) {
+ $redis->auth(config->{redis}{password});
+ }
+
+ $redis;
+}
+
+sub create {
+ my ($self, %args) = @_;
+ my $table = delete $args{table};
+ redis->lpush($table, JSON::XS::encode_json(\%args));
+}
+
+sub retrieve {
+ my ($self, %args) = @_;
+ my $table = delete $args{table};
+ my $offset = delete $args{offset} || 0;
+ my $limit = delete $args{limit} ? ($args{offset} + $args{limit}) - 1
+ : $args{offset};
+
+ +[ map { JSON::XS::decode_json($_) } redis->lrange($table, $offset, $limit) ];
+}
+
+sub update {}
+
+sub delete {}
+
+!!1;
No changes.
No changes.
@@ -0,0 +1,18 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html>
+<head>
+<title>Error 404</title>
+<link rel="stylesheet" href="/css/error.css" />
+<meta http-equiv="Content-type" content="text/html; charset=UTF-8" />
+</head>
+<body>
+<h1>Error 404</h1>
+<div id="content">
+<h2>Page Not Found</h2><p>Sorry, this is the void.</p>
+</div>
+<div id="footer">
+Powered by <a href="http://perldancer.org/">Dancer</a> 1.3030
+</div>
+</body>
+</html>
@@ -0,0 +1,18 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html>
+<head>
+<title>Error 500</title>
+<link rel="stylesheet" href="/css/error.css" />
+<meta http-equiv="Content-type" content="text/html; charset=UTF-8" />
+</head>
+<body>
+<h1>Error 500</h1>
+<div id="content">
+<h2>Internal Server Error</h2><p>Wooops, something went wrong</p>
+</div>
+<div id="footer">
+Powered by <a href="http://perldancer.org/">Dancer</a> 1.3030
+</div>
+</body>
+</html>
Oops, something went wrong.

0 comments on commit dfc5a98

Please sign in to comment.