ivan/compiled.world
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

big kahuna

Browse Source
This commit is contained in:
ivan
2026-08-15 23:05:57 -06:00
parent 6fec70c7c8
commit 84893662ca
25 changed files with 3886 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lib/CW/Controller.pm
View File

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

16
lib/CW/Controller/Index.pm
View File

@@ -2,19 +2,17 @@ package CW::Controller::Index;
use Moo;
with 'CW::Controller';
extends 'CW::Controller';
sub index {
my ( $self, $request, $response ) = @_;
$response->template(
[
head => [],
body => [
h1 => ["Foo Bar!"]
]
]
);
my $boards =
$self->dbh->selectall_arrayref( q[SELECT * FROM boards ORDER BY id],
{ Slice => {} } );
$response->template( 'Index',
{ title => 'compiled.world | home', boards => $boards } );
}
1;

18
lib/CW/Layout.pm Normal file
View File

@@ -0,0 +1,18 @@
package CW::Layout;
use Moo;
use Types::Standard qw(HashRef InstanceOf);
has template => (
is => 'ro',
required => 1,
isa => InstanceOf ['CW::Template']
);
has ctx => (
is => 'ro',
required => 1,
isa => HashRef
);
1;

134
lib/CW/Layout/Default.pm Normal file
View File

@@ -0,0 +1,134 @@
package CW::Layout::Default;
use Moo;
extends 'CW::Layout';
my $HACKERSPACE_LINK = "https://en.wikipedia.org/wiki/Hackerspace";
sub render {
my ($self) = @_;
my $ctx = $self->ctx // {};
if ( !$ctx->{nav} ) {
$ctx->{nav} = [];
my @path = split '/', $ctx->{env}->{PATH_INFO};
if (@path) {
my $nav = [];
for ( 0 .. $#path ) {
my $text = $path[$_];
my @prev = @path[ 0 .. $_ ];
push @$nav,
{
text => $text,
path => '/' . join( '/', ( @prev, $text ) )
};
}
}
}
my @additional_links;
if ( !$ctx->{user} ) {
push @additional_links, $self->_make_nav_link("login");
}
else {
if ( $ctx->{user}->is_admin ) {
push @additional_links, $self->_make_nav_link("admin");
}
push @additional_links, $self->_make_nav_link("logout");
}
my $board = $ctx->{board} // 'cw';
return [
head => [
title => [ $self->ctx->{title} ],
meta => { charset => 'UTF-8' },
meta => {
name => 'viewport',
content => 'width=device-width, initial-scale=1.0'
},
meta => {
name => 'description',
content => (
$self->ctx->{description}
// 'compiled.world, a gated hackerspace '
. 'for humans to interact with humans'
)
},
meta => {
name => 'robots',
content => 'index, follow'
},
link => {
href => '/static/css/shared.css',
rel => 'stylesheet'
},
link => {
href => '/static/css/' . $board . '.css',
rel => 'stylesheet'
}
],
body => [
header => [
div => [
div => {
class => "header-wrapper"
} => [
img => {
src => "/static/images/$board.svg",
class => "logo"
},
div => [
a => {
href => "/",
style => "text-decoration: none"
} => [
h1 => { style => "margin: 0" } =>
["compiled.world"]
],
p => { style => "margin-top: 0" } => [
"A digital ",
a => {
href => $HACKERSPACE_LINK
} => ["hackerspace"],
" for human beings"
],
nav => { class => "navbar" } => [
(
map { $self->_make_nav_link($_) }
qw(recent popular badges about)
),
@additional_links,
]
]
],
]
],
main => [
nav => { class => "quicknav" } => [
map {
(
li => [
"/",
a => { href => $_->{path} } => [ $_->{text} ]
]
)
} @{ $ctx->{nav} }
],
div => $self->template->render
],
footer => []
]
];
}
sub _make_nav_link {
my ( $self, $text ) = @_;
return a => { class => "navbar-link", href => "/$text" } => [$text];
}
1;

72
lib/CW/Migration.pm Normal file
View File

@@ -0,0 +1,72 @@
package CW::Migration;
use Moo;
use feature qw(state say);
use File::Find;
has dbh => (
is => 'ro',
required => 1
);
sub migrate {
my ($self) = @_;
return $self->_perform_migrations(pop)
if !ref($self) && $self eq __PACKAGE__;
$self->dbh->do(<<'SQL');
CREATE TABLE IF NOT EXISTS migrations (
id VARCHAR(4),
migration_sql TEXT NOT NULL,
PRIMARY KEY (id)
);
SQL
my $id = $self->id;
my $already_migrated = $self->already_migrated;
if ($already_migrated) {
say "[Migration] $id already migrated";
return;
}
$self->dbh->do( $self->sql );
$self->dbh->do( "INSERT INTO migrations (id, migration_sql) VALUES (?, ?)",
undef, $id, $self->sql );
say "[Migration] $id migrated successfully";
}
sub already_migrated {
my ($self) = @_;
my ($exists_check) =
$self->dbh->selectrow_array(
"SELECT 1 FROM migrations WHERE id = ? LIMIT 1",
undef, $self->id );
return $exists_check;
}
# static
sub _perform_migrations {
my ( $class, $dbh ) = @_;
find(
{
wanted => sub {
return unless /\.pm$/;
my @parts = split( /\/+/, $File::Find::name );
my $file = $parts[-1];
my $class = "CW::Migration::" . ( $file =~ s/\.pm$//r );
eval "use $class";
my $migration = $class->new( dbh => $dbh );
$migration->migrate;
}
},
'lib/CW/Migration'
);
}
1;

21
lib/CW/Migration/01.pm Normal file
View File

@@ -0,0 +1,21 @@
package CW::Migration::01;
use Moo;
use FindBin;
extends 'CW::Migration';
sub id {
return 1;
}
sub sql {
return <<'SQL';
CREATE TABLE sessions (
id CHAR(72) PRIMARY KEY,
session_data TEXT
)
SQL
}
1;

21
lib/CW/Migration/02.pm Normal file
View File

@@ -0,0 +1,21 @@
package CW::Migration::02;
use Moo;
extends 'CW::Migration';
sub id {
return 2;
}
sub sql {
return <<'SQL';
CREATE TABLE boards (
id VARCHAR(3) PRIMARY KEY,
name VARCHAR(100),
description TEXT
)
SQL
}
1;

60
lib/CW/Migration/03.pm Normal file
View File

@@ -0,0 +1,60 @@
package CW::Migration::03;
use Moo;
extends 'CW::Migration';
sub id {
return 3;
}
sub sql {
my $boards = [
{
id => 't',
name => 'Technology',
description => 'Programming, computing, hardware discussion'
},
{
id => 'b',
name => 'Money',
description => 'Finance, money, and business discussion'
},
{
id => 'a',
name => 'Art',
description => 'Human made art (all forms welcome) discussion'
},
{
id => 's',
name => 'Math & Science',
description => 'Math and science discussion'
},
{
id => 'g',
name => 'Games',
description => 'Video, Tabletop, TCG, gaming discussion'
},
{
id => 'm',
name => 'Meta',
description => 'Discussion about compiled.world'
}
];
my $values = join(
",",
map {
"('"
. $_->{id} . "', '"
. $_->{name} . "', '"
. $_->{description} . "')"
} @$boards
);
my $sql =
'INSERT INTO boards (id, name, description) VALUES ' . $values . ';';
return $sql;
}
1;

25
lib/CW/Migration/04.pm Normal file
View File

@@ -0,0 +1,25 @@
package CW::Migration::04;
use Moo;
extends 'CW::Migration';
sub id {
return 4;
}
sub sql {
return q[CREATE TABLE users (
id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY,
name VARCHAR(24),
password VARCHAR(62),
admin BOOLEAN DEFAULT false,
active BOOLEAN DEFAULT false,
denied BOOLEAN DEFAULT false,
denied_reason TEXT,
join_request JSON NOT NULL
)
]
}
1;

9
lib/CW/Plack/Request.pm
View File

@@ -10,13 +10,18 @@ has h => (
has _request => (
is => 'ro',
init_arg => 'request',
required => 1
required => 1,
handles => [qw(env)]
);
sub new_response {
my ( $self, @args ) = @_;
my $response = $self->_request->new_response(@args);
return CW::Plack::Response->new( response => $response, h => $self->h );
return CW::Plack::Response->new(
request => $self,
response => $response,
h => $self->h
);
}
1;

43
lib/CW/Plack/Response.pm
View File

@@ -1,6 +1,7 @@
package CW::Plack::Response;
use Moo;
use Carp ();
has _response => (
is => 'ro',
@@ -9,15 +10,53 @@ has _response => (
handles => [qw(finalize status body headers header)]
);
has request => (
is => 'ro',
required => 1,
handles => [qw(env)]
);
has h => (
is => 'ro',
required => 1
);
sub template {
my ( $self, $template ) = @_;
my $html = $self->h->html($template);
my ( $self, $template, $ctx ) = @_;
my $html;
# If rendering inline
if ( ref($template) && ref($template) eq 'ARRAY' ) {
$html = $self->h->html($template);
}
elsif ( !ref($template) ) {
$ctx //= {};
$ctx->{env} = $self->env;
## no strict [BuiltinFunctions::ProhibitStringyEval]
my $template_pkg = "CW::Template::$template";
eval "use $template_pkg";
my $layout_pkg =
"CW::Layout::" . ( delete( $ctx->{layout} ) // 'Default' );
## no strict [BuiltinFunctions::ProhibitStringyEval]
eval "use $layout_pkg";
my $layout = $layout_pkg->new(
template => $template_pkg->new( ctx => $ctx ),
ctx => $ctx
);
$html = $self->h->html( $layout->render );
}
else {
Carp::croak("Invalid value passed to template call: $template");
}
$self->_response->header( 'Content-Type' => 'text/html; encoding=utf-8' );
$self->_response->body($html);
return $self;
}

20
lib/CW/Template.pm Normal file
View File

@@ -0,0 +1,20 @@
package CW::Template;
use Moo;
use Types::Standard qw(HashRef);
has ctx => (
is => 'ro',
required => 1,
isa => HashRef
);
sub render {
my ($self) = @_;
return [
h1 => ["Undefined Template"],
p => [ "You should probably implement this template! " . ref($self) ]
];
}
1;

11
lib/CW/Template/Boards.pm Normal file
View File

@@ -0,0 +1,11 @@
package CW::Template::Boards;
use Moo;
extends 'CW::Template';
sub render {
my ($self) = @_;
}
1;

27
lib/CW/Template/Index.pm Normal file
View File

@@ -0,0 +1,27 @@
package CW::Template::Index;
use Moo;
extends 'CW::Template';
sub render {
my ($self) = @_;
my @boards = @{ $self->ctx->{boards} };
return [
map {
(
li => [
a => {
href => '/' . $_->{id} . '/',
class => 'index-board-link'
} => [ '/' . $_->{id} . '/ - ' . $_->{name} ],
p => { class => 'index-board-description' } =>
[ $_->{description} ]
]
)
} @boards
];
}
1;