WAF

subtech

19:28

結局、アプリケーション (not Web App = WWW 非依存) なものを Web っぽい部分とつなぐ Dispatcher (Router) があればよくて、あとはおまけっぽいので、HTTP::Engine + Router で WAF っぽい部分は終わりになるような気がした。

uri path -> 実際の処理の受け渡しが複数ファイルを見ないとわからないようなのはよくない。あっちいったりこっちいったりめんどうくさいし、ある uri へアクションを設定したいだけのためにファイル1個おいたり、とても無駄だ。

app 部分はまた別のものだ。

整理して github におきました: http://github.com/cho45/Chord/tree/master

#!/usr/bin/env perl
package FooRouter;

use Chord::Router::HTTP;
use base qw(Chord::Router::HTTP);

# define views
use JSON::XS;
sub json ($$) {
	my ($res, $stash) = @_;
	$res->header("Content-Type" => "application/json");
	$res->content(encode_json($stash));
}

use Text::MicroMason;
sub html ($%) {
	my ($res, $stash) = @_;
	my $m  = Text::MicroMason->new(qw/ -SafeServerPages -AllowGlobals /);
	$m->set_globals(map { ("\$$_", $stash->{$_}) } keys %$stash);

	my $content = $m->execute(text =>  q{
		<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
		<title><%= $title %></title>
		<p><%= $content %>
	});

	$res->header("Content-Type" => "text/html");
	$res->content($content);
}

# routing

route "/",
	action => sub {
		my ($req, $res) = @_;
		html $res, {
			title   => "Hello",
			content => "Hello",
		};
	};

route "/my/*path",
	action => sub {
		my ($req, $res) = @_;
		$res->code(302);
		$res->header("Location" => sprintf("/foo/%s", $req->param("path")));
	};

route "/:author/", author => qr/[a-z][a-z0-9]{1,30}/,
	action => sub {
		my ($req, $res) = @_;
		html $res, {
			title   => "Hello",
			content => sprintf("This is %s's page.", $req->param("author"))
		};
	};

route "/api/foo",
	action => sub {
		my ($req, $res) = @_;
		json $res, {
			foo => "bar"
		};
	};

route "/die",
	action => sub {
		die "Died";
	};


__PACKAGE__->run;

package Chord::Router::HTTP;
use Any::Moose;
use HTTP::Engine;

use Exporter::Lite;
our @EXPORT = qw(route);

our $routing = [];

sub route ($;%) {
	my ($path, %opts) = @_;
	my $regexp  = "^$path\$";
	my $capture = [];

	$regexp =~ s{([:*])(\w+)}{
		my $type = $1;
		my $name = $2;
		push @$capture, $name;
		sprintf("(%s)",
			$opts{$name} ||
			(($type eq "*") ? ".*": "[^\/]+")
		);
	}ge;

	push @$routing, {
		%opts,
		define  => $path,
		regexp  => $regexp,
		capture => $capture,
	};
}

sub dispatch {
	my ($self, $request) = @_;
	my $path   = $request->path;
	my $params = {};
	my $action;

	for my $route (@$routing) {
		if (my @capture = ($path =~ $route->{regexp})) {
			for my $name (@{ $route->{capture} }) {
				$params->{$name} = shift @capture;
			}
			$action = $route->{action};
			last;
		}
	}

	my $req = $request;
	$req->param(%$params);
	my $res = HTTP::Engine::Response->new(status => 200);
	$res->header("Content-Type" => "text/html");
	if ($action) {
		eval {
			$action->($req, $res);
		}; if ($@) {
			$res->code(500);
			$res->header("Content-Type" => "text/plain");
			$res->content($@);
		}
	} else {
		$res->code(404);
		$res->content("Not Found");
	}
	$res;
}

sub process {
	my ($self, $request) = @_;

	$self->dispatch($request);
}

sub run {
	my ($class, %opts) = @_;

	HTTP::Engine->new(
		interface => {
			module => 'ServerSimple',
			args   => {
				host => 'localhost',
				port =>  3001,
			},
			request_handler => sub {
				my $req = shift;
				$class->new->process($req);
			},
			%opts
		},
	)->run;
}


1;
__END__

❤️ 投げ銭する