concrete
This commit is contained in:
60
lib/CW.pm
Normal file
60
lib/CW.pm
Normal file
@@ -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;
|
||||
62
lib/CW/Config.pm
Normal file
62
lib/CW/Config.pm
Normal file
@@ -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;
|
||||
7
lib/CW/Controller.pm
Normal file
7
lib/CW/Controller.pm
Normal file
@@ -0,0 +1,7 @@
|
||||
package CW::Controller;
|
||||
|
||||
use Moo;
|
||||
|
||||
has dbh => ( is => 'ro' );
|
||||
|
||||
1;
|
||||
20
lib/CW/Controller/Index.pm
Normal file
20
lib/CW/Controller/Index.pm
Normal file
@@ -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;
|
||||
22
lib/CW/Plack/Request.pm
Normal file
22
lib/CW/Plack/Request.pm
Normal file
@@ -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;
|
||||
24
lib/CW/Plack/Response.pm
Normal file
24
lib/CW/Plack/Response.pm
Normal file
@@ -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;
|
||||
52
lib/CW/Route.pm
Normal file
52
lib/CW/Route.pm
Normal file
@@ -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;
|
||||
31
lib/CW/Router.pm
Normal file
31
lib/CW/Router.pm
Normal file
@@ -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;
|
||||
Reference in New Issue
Block a user