Slides for the talk web-simple at lpw-2012
-
Fast
Furious
Fatpackable
Fun
-
Web::Simple
-
IPW 2009
-
Antiquated
Perl
-
Looking
for sugar
-
No XS
-
sub (/users/) { ... }
-
perldoc -f
prototype
-
Dispatchers
are annotated
subroutines
-
Dispatchers
can return
dispatchers
-
No enforced
structure
-
This computer
has no brain
- use your own
-
What does
this mean?
-
Build from
the backend
forwards
-
Example:
App::EzPz
-
ezmlm list
moderation
-
First I wrote
Email::EzPz
-
use_module('Email::EzPz::List')->new(
list_dir => $list_dir,
ezmlm_bindir => $bin_dir,
);
-
$list->add_member('joe@example.com')
-
sub add_member {
my ($self, $member) = @_;
$self->_call_command(sub => $member);
return $member;
}
-
sub _call_command {
my ($self, @cmd) = @_;
run $self->_command_args(@cmd);
}
-
IPC::System::Simple
provides run()
-
die()s on
non-zero
exit code
-
$list->members
-
sub members {
my ($self) = @_;
$self->_capture_command('list');
}
-
sub _capture_command {
my ($self, @cmd) = @_;
map { chomp; $_ } capture $self->_command_args(@cmd);
}
-
capture()
returns
stdout
-
ezmlm-list path/to/list
-
returns
list of
users
-
All nice
and simple
-
Web UI
on top
-
App::EzPz::Web
-
sub dispatch_request {
my ($self) = @_;
my $users = $self->users;
my $current_user;
-
my $current_user
-
dispatch_request
is called
each request
-
We don't
need no
$c->stash()
-
Authentication?
-
Easy!
-
sub () {
return if $_[PSGI_ENV]->{REMOTE_USER};
return use_module('Plack::Middleware::Auth::Basic')->new(
authenticator => sub { $users->check_password(@_) }
)
},
-
return if $_[PSGI_ENV]->{REMOTE_USER};
-
If under apache,
this already
got handled
via .htaccess
-
return nothing
-> dispatch
continues
-
return use_module('Plack::Middleware::Auth::Basic')
-
return middleware
-> dispatch is
wrapped by it
then continues
-
sub () {
$current_user = $users->get(my $name = $_[PSGI_ENV]->{REMOTE_USER});
return [
401, [ 'Content-type' => 'text/plain' ], [ "No such user $name" ]
] unless $current_user;
return;
},
-
return [ 401, ... ]
unless $current_user;
-
PSGI response
-> returned
to server
-
return;
-
User found
-> dispatch
continues
-
sub (/list/*/...) {
my $list = $current_user->get_list($_[1]);
return unless $list;
-
/list/*/...
-
/list/listname/
$_[1] eq 'listname'
-
/list/listname/...
-
... means
subdispatch
-
SCRIPT_NAME
PATH_INFO
-
/list/listname/
SCRIPT_NAME => /list/listname
PATH_INFO => /
-
/list/listname/foo/
SCRIPT_NAME => /list/listname
PATH_INFO => /foo/
-
sub (/list/*/...) {
my $list = $current_user->get_list($_[1]);
return unless $list;
my $error;
sub (/) {
$self->_list_dispatchers($current_user, $list, \$error),
sub () { $self->_render_list_page($list, $error) };
},
-
_list_dispatchers
is ... just a
method
-
... that returns
a re-usable
set of dispatchers
-
sub _list_dispatchers {
my ($self, $current_user, $list, $error_ref) = @_;
my $name = $current_user->username;
sub (POST) {
sub (%add=) {
$self->audit_action($name, $list->name, 'add', $_[1]);
eval { $list->add_member($_[1]); 1 }
or ${$error_ref} = $@;
return;
},
-
POST -> HTTP method
%add= -> body param
-
return means
dispatch still
continues ...
-
sub (/) {
$self->_list_dispatchers($current_user, $list, \$error),
sub () { $self->_render_list_page($list, $error) };
},
-
_render_list_page
uses HTML::Zoom
-
->repeat('.list-member', [
map {
my $email = $_;
sub {
$_->replace_content('.list-member-name', $email)
->set_attribute('.list-member-remove', value => $email);
}
} $list->members
]);
-
<li class="list-member">
<form method="POST">
<span class="list-member-name" />
<input class="list-member-remove" type="hidden" name="remove" />
<input value="Remove" type="submit" />
</form>
</li>
-
End result?
-
1 weekend
547 lines
-
"It's a bit modern perl
for my taste but
otherwise pretty good"
(Robert Spier)
-
Small todo list
and this will
help moderate
perl.org lists
-
-
A small
digression
-
We seem to
rewrite our
"CMS" every
time we change
domain names
-
shadowcatsystems.co.uk
-
shadowcatsystems.co.uk
plain HTML
-
shadowcatsystems.co.uk
plain HTML
maintained by hand
-
shadowcat.co.uk
-
shadowcat.co.uk
Catalyst (Reaction) app
-
shadowcat.co.uk
Catalyst (Reaction) app
svn for pages
FastCGI deployment
-
HN killed the
server once
-
... because I'd
accidentally left
static files served
via apache :(
-
shadow.cat
-
shadow.cat
???
-
Wanted
something
simpler
-
But but but
simpler is
BORING
-
SCS = Shadowcat Site
-
SCS = Shadowcat Site
SCS = Simple Content Server
-
Oooooh!
-
-
SCS
-
Content
serving
-
Blog list
pages
-
Feeds
-
Pluggable
ALL the
things!
-
sub BUILD {
my ($self) = @_;
$self->load_plugin(Core => {});
my @plist = @{$self->config->{plugins}||[]};
while (my ($name, $conf) = splice @plist, 0, 2) {
$self->load_plugin($name, $conf);
}
}
-
sub dispatch_request {
my ($self) = @_;
map $_->page_dispatchers, reverse @{$self->app->plugins}
}
-
Plugins
supply
dispatchers
-
Core
plugin
-
sub page_dispatchers {
my ($self) = @_;
-
sub (/) {
$self->pages->get({ path => 'index' });
},
sub (/**:path/) {
$self->pages->get({ %_ })
},
-
/**:path/
-
/foo/bar/baz/
{ path => 'foo/bar/baz' }
-
If $_[1] is
a hashref
-
... Web::Simple
puts it in %_
-
# $_{path} = 'foo/bar/baz'
$self->pages->get({ %_ })
-
PageSet.pm
-
sub get {
my ($self, $spec) = @_;
$spec->{path} or die "path is required to get";
my ($dir, $file) = $spec->{path} =~ m{^(?:(.*)/)?([^/]+)$};
-
my @poss = io->dir($self->base_dir)->${\sub {
my $io = shift;
defined($dir) ? $io->catdir($dir) : $io
}}->filter(sub {
$_->filename =~ /^\Q${file}\E${\$self->_types_re}$/ and $type = $1
})
->${\sub { -e "$_[0]" ? $_[0]->all_files : () }};
-
What?
-
my @poss = io->dir($self->base_dir)->${\sub {
my $io = shift;
defined($dir) ? $io->catdir($dir) : $io
}}
-
IO::All catdir
for foo/bar of
foo/bar/baz
-
or no-op
if page
just 'foo'
-
}}->filter(sub {
$_->filename =~ /^\Q${file}\E${\$self->_types_re}$/ and $type = $1
})
-
Looks for
baz.md/baz.html
-
->${\sub { -e "$_[0]" ? $_[0]->all_files : () }};
-
all_files on
nonexistant
directory
would die()
-
(IO::All - ingycode
that actually makes
your program -more-
reliable ...)
-
$self->_inflate(
$type, $self->rel_path->catdir($spec->{path}), $poss[0]
);
-
Construct page
object from
found file.
-
Rendering!
-
MOAR
PLUGINS
-
sub page_plugins {
...
PageData => 'App::SCS::Plugin::Core::PagePlugin::PageData',
}
-
PageData.pm
-
sub filter_content_zoom {
my ($self, $zoom) = @_;
my $page = $self->page;
$zoom->select('.page.title')->replace_content($page->title)
->select('.page.subtitle')->${\sub {
$page->subtitle
? $_[0]->replace_content($page->subtitle)
: $_[0]->replace('')
}}
->select('.page.published_at')->replace_content($page->published_at)
->select('meta[name=description]')
->set_attribute(content => $page->description)
->select('meta[name=keywords]')
->set_attribute(content => $page->keywords)
->select('meta[name=created]')
->set_attribute(content => $page->created);
}
-
filter_content_zoom?
-
Three stage
rendering
pipeline
-
Page object
... is a PSGI
app itself
-
sub to_app {
my ($self) = @_;
return sub { $self->to_psgi_response(@_) };
}
-
sub _html_zoom {
my ($self) = @_;
return reduce {
$b->filter_html_zoom($a)
} HTML::Zoom->from_html($self->html), @{$self->_page_plugins};
}
-
_html_zoom phase
builds up the
overall HTML
-
templates and
layouts applied
at this stage
-
sub _content_zoom {
my ($self) = @_;
return reduce {
$b->filter_content_zoom($a)
} $self->_html_zoom, @{$self->_page_plugins};
}
-
_content_zoom
phase weaves
data into
the HTML
-
$zoom->select('.page.title')
->replace_content($page->title)
-
<title class="page title" />
-
No messing about
passing data up
to the layout
-
SubList plugin
applies here to
provide blog
index pages
-
sub _build__psgi_response {
my ($self) = @_;
my $psgi_res = [
200, [ 'Content-type' => 'text/html' ], $self->_content_zoom->to_fh
];
return reduce {
$b->filter_psgi_response($a)
} $psgi_res, @{$self->_page_plugins};
}
-
_psgi_response
phase can modify
anything
-
non-200 statuses
headers
etc.
-
So, pages
sorted.
-
Feeds!
-
sub page_dispatchers {
my ($self) = @_;
my $base = $self->mount_at;
"/${base}/**/" => sub {
if (my $conf = $self->config->{$_[1]}) {
$conf = { base => $_[1], %$conf };
$self->_feed_http_response(200 => $conf => $_[-1]);
}
},
}
-
# dynamic path so use string
# form rather than prototypes
"/${base}/**/" => sub {
-
has generator => (
is => 'lazy',
handles => { _feed_http_response => 'feed_http_response' },
);
-
Generator.pm
-
sub feed_http_response {
my ($self, $code, $feed_config, $env) = @_;
$self->_feed_response(
$code, $self->_config_to_data($feed_config, $env)
);
}
-
sub _config_to_data {
...
+{
%$config,
entries => [ map {
my $page_url = $abs->(do { (my $p = $_->path) =~ s/^\///; "$p/" });
+{
title => $_->title,
summary_html => do {
use HTML::Tags;
join '', HTML::Tags::to_html_string(<p>, $_->description, </p>)
},
content_html => $self->_content_html($_, $base_url, $page_url),
created => join('T', split(' ',$_->created)).'Z',
web_url => $page_url,
}
} @entry_pages ],
}
-
<p>, $_->description, </p>
-
<p> is readline(*p)
</p> is glob('/p')
-
tie *p, 'XML::Tags::TIEHANDLE', ...
*{'CORE::GLOBAL::glob'} = $sub;
-
Well ...
not quite
-
delete ${CORE::GLOBAL::}{glob};
no strict 'refs';
*{'CORE::GLOBAL::glob'} = $_[0];
-
Why?
-
# stupid insanity. delete anything already there so we disassociated
# the *CORE::GLOBAL::glob typeglob. Then the string reference call
# revivifies it - i.e. creates us a new glob, which we get a reference
# to, which we can then assign to.
# doing it without the quotes doesn't - it binds to the version in scope
# at compile time, which means after a delete you get a nice warm segv.
-
Anyway ...
-
sub _feed_data_to_tags {
my ($self, $data) = @_;
use XML::Tags qw(
feed title subtitle link id
);
my ($web_url, $feed_url) = @{$data}{qw(web_url feed_url)};
-
(\'<?xml version="1.0" encoding="UTF-8"?>', "\n",
<feed xmlns="http://www.w3.org/2005/Atom">, "\n",
' ', <title type="text">, $data->{title}, </title>, "\n",
($data->{subtitle}
? (' ', <subtitle type="text">, $data->{subtitle}, </subtitle>, "\n",)
: ()),
' ', <link rel="alternate" type="text/html" href="${web_url}" />, "\n",
' ', <link rel="self" type="application/atom+xml" href="${feed_url}" />, "\
n",
' ', <updated>, $data->{updated}, </updated>, "\n",
' ', <id>, $data->{id}, </id>, "\n",
(map $self->_entry_data_to_tags($_), @{$data->{entries}}),
</feed>);
-
So, feeds
sorted.
-
(though you may
need a change
of underwear)
-
What about
a dev server?
-
Easy!
-
Server
plugin
-
sub _build__static_handler {
my ($self) = @_;
use_module('Plack::App::File')->new(
root => $self->app->share_dir->catdir('static')
);
}
-
sub page_dispatchers {
my ($self) = @_;
sub (/static/...) { $self->_static_handler },
sub (/favicon + .ico) { $self->_static_handler },
}
-
Static dispatchers
only exist for
the server
-
... so I can't
make that config
mistake again :D
-
sub run_command_server {
my ($self, $env) = @_;
my @args = @{$env->{argv}};
my $r = use_module('Plack::Runner')->new(
server => 'Starman',
app => $self->app->web->to_psgi_app
);
$r->parse_options(@args);
$r->set_options(argv => \@args);
$r->run;
}
-
That's really
just starman.
-
$env there is
a *CLI* env
not a PSGI one
-
(yes, even the
CLI commands
are pluggable)
-
$ bin/site server
...
Starman: Accepting connections at http://*:5000/
-
Aaaand
we're done?
-
Not
quite!
-
Generate
Plugin
-
Generate.pm
-
foreach my $path (@all_paths) {
warn "Generating ${path}\n";
my $res = $self->app->web->run_test_request(GET => "${prefix}${path}");
my $dir = $dir->catdir($path);
$dir->mkpath;
# text/html -> html
# application/atom+xml -> atom
my ($ext) = $res->content_type =~ m{\/(\w+)}
or die "Couldn't parse extension"
." from content type ${\$res->content_type}"
." for path ${path}";
$dir->catfile("index.${ext}")->print($res->content);
}
-
run_test_request
is part of
Web::Simple::Application
-
Uses Plack::Test
to return an
HTTP response
-
... so we can
write out the
pages to disk
-
@all_paths
-
my @all_paths = map $_->provides_pages, @{$self->app->plugins};
-
my @all_paths = map $_->provides_pages, @{$self->app->plugins};
#
# Core.pm has -
sub provides_pages {
my ($self) = @_;
"/", map "$_/", $self->pages->all_paths;
}
-
my @all_paths = map $_->provides_pages, @{$self->app->plugins};
#
# Feeds.pm has -
sub provides_pages {
my ($self) = @_;
my $base = $self->mount_at;
return map "/${base}/$_/", keys %{$self->config};
}
-
my $opt = $env->{options};
if (my $only = $opt->{only}) {
my $re = qr/^${only}/;
@all_paths = grep /$re/, @all_paths;
}
-
$ bin/site generate /blog/matt-s-trout
-
... wait.
-
$env->{options}
-
sub run_command_generate (dir=s;host=s;only=s) {
-
Yes, that's
a getopt
spec in the
prototype
-
$ bin/site generate
$ rsynz -avz -e ssh out/ $TARGET:/var/www/shadow.cat/docroot
-
# This is actually how we publish shadow.cat
#
$ bin/site generate
$ rsynz -avz -e ssh out/ $TARGET:/var/www/shadow.cat/docroot
-
App::EzPz
and
App::SCS
are in
git.shadowcat.co.uk
-
#web-simple
is on
irc.perl.org
-
Happy
hacking!
-
Thank You
IRC:mst
mst@shadowcat.co.uk
@shadowcat_mst