concrete

.gitignore

@@ -0,0 +1,2 @@
+config.yml
+.env*

bin/compiled.world.psgi

@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+
+use 5.036;
+
+use strict;
+use warnings;
+
+use FindBin;
+use Plack::Builder;
+use DBIx::Connector;
+use HTML::Composer;
+
+use lib "$FindBin::Bin/../lib";
+
+use CW;
+use CW::Config;
+use CW::Router;
+
+my $h       = HTML::Composer->new();
+my $conf    = CW::Config->new;
+my $db_conf = $conf->get('db');
+my $conn    = DBIx::Connector->new(
+    $db_conf->get('dsn'),
+    $db_conf->get('username'),
+    $db_conf->get('password')
+);
+
+my $router = CW::Router->new();
+
+$router->get('/')->action('Index#index');
+
+builder {
+    sub {
+        CW->new(
+            dbh         => $conn->dbh,
+            environment => $conf->get('environment'),
+            h           => $h,
+            router      => $router
+        )->app->(@_);
+    }
+};

config.example.yml

@@ -0,0 +1,8 @@
+db:
+  dsn: 'DBI:MariaDB:database=compiledworld;host=127.0.0.1;port=3306'
+  username: 'compiledworld'
+  password: 'compiledworld'
+
+# dev | prod | ci
+environment: 'dev'
+behind_proxy: false

cpanfile

@@ -0,0 +1,5 @@
+requires "HTML::Composer";
+requires "Plack";
+requires "Moo";
+requires "Starman";
+requires "Router::Simple";

lib/CW.pm

@@ -0,0 +1,60 @@
+
+# This is the main class for compiled.world, it is instantiated every request
+# Routes, database connections, and other data around the request lifecycle are passed
+# as attributes, and should not be instantiated per request.
+package CW;
+
+use Moo;
+use Plack::Request;
+
+use CW::Plack::Request;
+use CW::Plack::Response;
+
+has h => (
+    is       => 'ro',
+    required => 1
+);
+
+has dbh => (
+    is       => 'ro',
+    required => 1
+);
+
+has environment => (
+    is       => 'ro',
+    required => 1
+);
+
+has router => (
+    is       => 'ro',
+    required => 1
+);
+
+sub app {
+    my ($self) = @_;
+    return sub {
+        my ($env) = @_;
+        my $plack_request = Plack::Request->new($env);
+
+        my $request =
+          CW::Plack::Request->new( request => $plack_request, h => $self->h );
+        my $response = $request->new_response(200);
+
+        my $match = $self->router->match($env);
+
+        if ($match) {
+            my $route  = $match->{route};
+            my $pkg    = $route->pkg;
+            my $action = $route->action;
+            $pkg->new->$action( $request, $response );
+        }
+        else {
+            $response->status(404);
+            $response->body("404 not found");
+        }
+
+        return $response->finalize;
+    }
+}
+
+1;

lib/CW/Config.pm

@@ -0,0 +1,62 @@
+package CW::Config;
+
+use Moo;
+
+use Carp ();
+use YAML::Tiny;
+
+has file => (
+    is      => 'ro',
+    default => sub {
+        'config.yml';
+    }
+);
+
+has _config => ( is => 'rw' );
+
+sub get {
+    my ( $self, @args ) = @_;
+
+    $self->_load_config unless $self->_config;
+
+    if ( @args > 1 ) {    # Looking up nested args
+        my $tar = $self->_config;
+        for (@args) {
+            Carp::croak( "Invalid config lookup: " . join( ' -> ', @args ) )
+              unless $tar;
+            $tar = $tar->{$_};
+        }
+        return $tar;
+    }
+
+    if ( !@args ) {       # No args, return config
+        return $self->_config;
+    }
+
+    my ($key) = @args;                    # One arg, get single config element
+    my $val = $self->_config->{$key};
+
+    if ( ref($val) && ref($val) eq 'HASH' ) {
+
+   # If the value selected is a hash, return a new CW::Hash so we can chain gets
+        my $next = CW::Config->new();
+        $next->_config($val);
+        return $next;
+    }
+
+    return $val;
+}
+
+sub _load_config {
+    my ($self) = @_;
+
+    my $file      = $self->file;
+    my $yaml_docs = YAML::Tiny->read($file);
+
+    Carp::croak("Config: $file didn't load properly!")
+      unless $yaml_docs && $yaml_docs->[0];
+
+    $self->_config( $yaml_docs->[0] );
+}
+
+1;

lib/CW/Controller.pm

@@ -0,0 +1,7 @@
+package CW::Controller;
+
+use Moo;
+
+has dbh => ( is => 'ro' );
+
+1;

lib/CW/Controller/Index.pm

@@ -0,0 +1,20 @@
+package CW::Controller::Index;
+
+use Moo;
+
+with 'CW::Controller';
+
+sub index {
+    my ( $self, $request, $response ) = @_;
+
+    $response->template(
+        [
+            head => [],
+            body => [
+                h1 => ["Foo Bar!"]
+            ]
+        ]
+    );
+}
+
+1;

lib/CW/Plack/Request.pm

@@ -0,0 +1,22 @@
+package CW::Plack::Request;
+
+use Moo;
+
+has h => (
+    is       => 'ro',
+    required => 1
+);
+
+has _request => (
+    is       => 'ro',
+    init_arg => 'request',
+    required => 1
+);
+
+sub new_response {
+    my ( $self, @args ) = @_;
+    my $response = $self->_request->new_response(@args);
+    return CW::Plack::Response->new( response => $response, h => $self->h );
+}
+
+1;

lib/CW/Plack/Response.pm

@@ -0,0 +1,24 @@
+package CW::Plack::Response;
+
+use Moo;
+
+has _response => (
+    is       => 'ro',
+    init_arg => 'response',
+    required => 1,
+    handles  => [qw(finalize status body headers header)]
+);
+
+has h => (
+    is       => 'ro',
+    required => 1
+);
+
+sub template {
+    my ( $self, $template ) = @_;
+    my $html = $self->h->html($template);
+    $self->_response->body($html);
+    return $self;
+}
+
+1;

lib/CW/Route.pm

@@ -0,0 +1,52 @@
+package CW::Route;
+
+use Moo;
+
+use Types::Standard qw(Str HashRef Undef);
+use Carp            ();
+
+has path => (
+    is       => 'ro',
+    required => 1,
+    isa      => Str
+);
+
+has pkg => (
+    is  => 'rw',
+    isa => Str
+);
+
+has _auth => (
+    is  => 'rw',
+    isa => HashRef | Undef
+);
+
+has _action => (
+    is  => 'rw',
+    isa => Str
+);
+
+sub action {
+    my ( $self, $action_definition ) = @_;
+
+    return $self->_action unless $action_definition;
+
+    my ( $pkg, $action ) = split( '#', $action_definition );
+
+    $pkg = "CW::Controller::$pkg";
+
+    eval "use $pkg";
+    $self->pkg($pkg);
+    $self->_action($action);
+
+    return $self;
+}
+
+sub auth {
+    my ( $self, $auth ) = @_;
+    return $self->_auth unless $auth;
+    $self->_auth($auth);
+    return $self;
+}
+
+1;

lib/CW/Router.pm

@@ -0,0 +1,31 @@
+package CW::Router;
+
+use Moo;
+use Router::Simple;
+use Carp ();
+
+use CW::Route;
+
+has _router => (
+    is      => 'ro',
+    default => sub { Router::Simple->new },
+    handles => [qw(match)]
+);
+
+{
+    ## no critic [TestingAndDebugging::ProhibitNoStrict]
+    no strict 'refs';
+    for (qw(get post put patch delete)) {
+        *{ __PACKAGE__ . '::' . $_ } = sub {
+            my ( $self, $path ) = @_;
+
+            Carp::croak("Invalid path for route!") unless $path;
+
+            my $route = CW::Route->new( path => $path );
+            $self->_router->connect( $path, { route => $route } );
+            return $route;
+        }
+    }
+}
+
+1;