Telephone +44(0)1524 64544
Email: info(at)shadowcat.co.uk

Sat Dec 22 00:30:00 2012

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