Permalink
Browse files

Add the dancer VHS API app

  • Loading branch information...
1 parent 76613cb commit 8112120d7f63831a0a35890633330a473635a4a3 @lukec lukec committed Nov 13, 2012
View
@@ -7,3 +7,4 @@ door.log
arduino_door_tweet/applet/*
status.d/
space_displayduino/applet/
+vhsapi/config.yml
View
@@ -0,0 +1 @@
+config.yml
View
@@ -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/VHSAPI.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
View
@@ -0,0 +1,13 @@
+^\.git\/
+maint
+^tags$
+.last_cover_stats
+Makefile$
+^blib
+^pm_to_blib
+^.*.bak
+^.*.old
+^t.*sessions
+^cover_db
+^.*\.log
+^.*\.swp$
View
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'VHSAPI',
+ AUTHOR => q{YOUR NAME <youremail@example.com>},
+ VERSION_FROM => 'lib/VHSAPI.pm',
+ ABSTRACT => 'YOUR APPLICATION ABSTRACT',
+ ($ExtUtils::MakeMaker::VERSION >= 6.3002
+ ? ('LICENSE'=> 'perl')
+ : ()),
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'YAML' => 0,
+ 'Dancer' => 1.311,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'VHSAPI-*' },
+);
View
@@ -0,0 +1,4 @@
+#!/usr/bin/env perl
+use Dancer;
+use VHSAPI;
+dance;
View
@@ -0,0 +1,32 @@
+# 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: "VHSAPI"
+
+# 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"
+
+serializer: JSON
+
+template: "template_toolkit"
+engines:
+ template_toolkit:
+ encoding: 'utf8'
+ start_tag: '[%'
+ end_tag: '%]'
+ JSON:
+ allow_blessed: '1'
+ convert_blessed: '1'
+
+plugins:
+ Redis:
+ reconnect: 1
+
@@ -0,0 +1,27 @@
+# configuration file for development environment
+
+# the logger engine to use
+# console: log messages to STDOUT (your console where you started the
+# application server)
+# file: log message to a file in log/
+logger: "console"
+
+# the log level for this environment
+# core is the lowest, it shows Dancer's core log messages as well as yours
+# (debug, info, warning and error)
+log: "debug"
+
+# should Dancer consider warnings as critical errors?
+warnings: 1
+
+# should Dancer show a stacktrace when an error is caught?
+show_errors: 1
+
+# auto_reload is a development and experimental feature
+# you should enable it by yourself if you want it
+# Module::Refresh is needed
+#
+# Be aware it's unstable and may cause a memory leak.
+# DO NOT EVER USE THIS FEATURE IN PRODUCTION
+# OR TINY KITTENS SHALL DIE WITH LOTS OF SUFFERING
+auto_reload: 1
@@ -0,0 +1,17 @@
+# configuration file for production environment
+
+# only log warning and error messsages
+log: "warning"
+
+# log message to a file in logs/
+logger: "file"
+
+# don't consider warnings critical
+warnings: 0
+
+# hide errors
+show_errors: 0
+
+# cache route resolution for maximum performance
+route_cache: 1
+
View
@@ -0,0 +1,53 @@
+package VHSAPI;
+use Dancer ':syntax';
+use VHSAPI::Redis;
+use VHSAPI::Hackspace;
+
+our $VERSION = '0.1';
+
+hook before => sub {
+ VHSAPI::Redis->Init;
+ if (request->path =~ m#^/s/(\w+)#) {
+ var space => VHSAPI::Hackspace->By_name($1);
+ }
+};
+
+hook before_template => sub {
+ my $p = shift;
+ $p->{hackspaces} = VHSAPI::Hackspace->All;
+ $p->{space} = vars->{space};
+};
+
+get '/' => sub {
+ template 'index';
+};
+
+get '/s/:spacename/data/:dataname.json' => sub {
+ my $space = vars->{space} or redirect '/';
+ my $dp = $space->datapoint(params->{dataname});
+ return $dp->to_hash;
+};
+
+get '/s/:spacename/data/:dataname/update' => sub {
+ my $space = vars->{space} or redirect '/';
+ my $dataname = params->{dataname};
+ my $value = params->{value};
+ my $dp = $space->datapoint($dataname);
+ if ($dp) {
+ debug "Updating datapoint";
+ $dp->update($value);
+ }
+ else {
+ debug "Creating datapoint";
+ $dp = $space->add_datapoint($dataname, $value);
+ }
+ return { status => 'OK', result => $dp->to_hash };
+};
+
+get '/s/:spacename/data/:dataname' => sub {
+ my $space = vars->{space} or redirect '/';
+ template 'data', { datapoint => $space->datapoint(params->{dataname}) };
+};
+
+
+true;
@@ -0,0 +1,35 @@
+package VHSAPI::Datapoint;
+use Moose;
+use Dancer ':syntax';
+use methods-invoker;
+
+has 'name' => (is => 'rw', isa => 'Str', required => 1);
+has 'value' => (is => 'rw', isa => 'Str', required => 1);
+has 'last_updated' => (is => 'rw', isa => 'Int', required => 1);
+has 'space' => (is => 'rw', isa => 'Object');
+
+extends 'VHSAPI::Object';
+
+method All_for_hackspace ($class: $space) {
+ my $name = $space->name;
+ return [
+ map { $_->space($space); $_ }
+ map { $class->thaw( $class->redis->get("$name-data-$_") ) }
+ $class->redis->smembers("$name-datas")
+ ];
+}
+
+method uri { $->space->uri . '/data/' . $->name }
+method to_hash { return { map { $_ => $->$_ } qw/name value last_updated/ } }
+
+method update ($value) {
+ return if $value eq $->value;
+ $->value($value);
+ $->last_updated(time);
+ debug $->freeze;
+ my $frozen = $->freeze;
+ $->redis->set($->space->name . '-data-' . $->name, $frozen);
+ $->redis->lpush($->space->name . '-datahistory-' . $->name, $frozen);
+
+ $->space->notify($self);
+}
@@ -0,0 +1,61 @@
+package VHSAPI::Hackspace;
+use Dancer ':syntax';
+use Moose;
+use VHSAPI::Datapoint;
+use methods-invoker;
+use Net::Twitter::Lite;
+
+has 'name' => (is => 'rw', isa => 'Str', required => 1);
+has 'title' => (is => 'rw', isa => 'Str', required => 1);
+has 'datas' => (is => 'rw', isa => 'ArrayRef', lazy_build => 1);
+
+extends 'VHSAPI::Object';
+
+method uri { '/s/' . $->name }
+
+method By_name ($class: $name) { $class->thaw( $class->redis->get($name) ) }
+
+method _build_datas { VHSAPI::Datapoint->All_for_hackspace($self) }
+
+method datapoint ($name) {
+ my $keyname = $->name . '-data-' . $name;
+ debug "loading @{[$->name]} datapoint $name from $keyname";
+ my $dp = VHSAPI::Datapoint->thaw( $->redis->get($keyname) );
+ unless ($dp) {
+ debug "Couldn't find datapoint at $keyname";
+ return undef;
+ }
+ $dp->space($self);
+ return $dp;
+}
+
+method add_datapoint ($name, $value) {
+ my $dp = VHSAPI::Datapoint->new(
+ name => $name,
+ value => $value,
+ last_updated => time(),
+ );
+ $->redis->set($->name . '-data-' . $name, $dp->freeze);
+ return $->datapoint($name);
+}
+
+method notify ($dp) {
+ my $T = config->{Twitter};
+ my $nt = Net::Twitter::Lite->new(
+ useragent => 'VHSAPI',
+ consumer_key => $T->{consumer_key},
+ consumer_secret => $T->{consumer_secret},
+ legacy_lists_api => 0,
+ );
+ $nt->access_token($T->{access_token});
+ $nt->access_token_secret($T->{access_token_secret});
+ unless ($nt->authorized) {
+ die "Twitter oauth failed!";
+ }
+ my $result = eval { $nt->update("The @{[$dp->name]} is now @{[$dp->value]}.") };
+ if ($@) {
+ debug "Tweet failed: $@";
+ }
+ return $nt;
+
+}
@@ -0,0 +1,22 @@
+package VHSAPI::Object;
+use Moose;
+use Dancer ':syntax';
+use JSON ();
+use VHSAPI::Redis;
+use methods-invoker;
+
+method All ($class:) {
+ my $key = ref($class) || $class;
+ $key =~ s/^.+::(\w+)$/lc($1) . 's'/e;
+ return [map { debug "Loading object '$_'"; $class->thaw($class->redis->get($_)) } $class->redis->smembers($key)];
+}
+
+method freeze { JSON->new->encode($self->to_hash) }
+method thaw ($class: $val) {
+ return undef unless $val;
+ my $json = JSON->new->decode($val);
+ return $class->new($json);
+}
+
+method redis { VHSAPI::Redis->Redis }
+
@@ -0,0 +1,8 @@
+package VHSAPI::Redis;
+use Moose;
+use methods-invoker;
+use Redis;
+
+my $Redis;
+method Init { $Redis = Redis->new }
+method Redis {$Redis || $->Init }
View
@@ -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>.
+</div>
+</body>
+</html>
View
@@ -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>.
+</div>
+</body>
+</html>
Oops, something went wrong.

0 comments on commit 8112120

Please sign in to comment.