]>
Commit | Line | Data |
---|---|---|
7dc32473 MG |
1 | package Plack::App::Gruntmaster; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Plack::Component/; | |
7 | no if $] >= 5.017011, warnings => 'experimental::smartmatch'; | |
8 | our $VERSION = '5999.000_001'; | |
9 | ||
10 | use HTTP::Negotiate qw/choose/; | |
11 | use Plack::Request; | |
12 | ||
13 | my %handlers; | |
14 | ||
15 | sub call { | |
16 | my $env = $_[1]; | |
17 | my $r = Plack::Request->new($env); | |
18 | my @handlers = @{ $handlers{$r->method} // [] }; | |
19 | for my $handler (@handlers) { | |
20 | my ($re, $obj) = @$handler; | |
21 | my @args; | |
22 | next unless @args = $r->path =~ m/^$re$/a; | |
23 | my $format = choose $obj->variants, $r->headers; | |
24 | return $obj->generate($format, $env->{'psgix.logger'}, map { $_ // '' } @args); | |
25 | } | |
26 | ||
27 | [404, ['Content-Type' => 'text/plain'], ['Not found']] | |
28 | } | |
29 | ||
30 | sub get { | |
31 | my ($re, $obj) = @_; | |
32 | eval "require Gruntmaster::Page::$obj" or die $@; | |
33 | push @{$handlers{GET }}, [ $re, "Gruntmaster::Page::$obj" ] | |
34 | } | |
35 | ||
36 | sub post { | |
37 | my ($re, $obj) = @_; | |
38 | eval "require Gruntmaster::Page::$obj" or die $@; | |
39 | push @{$handlers{POST}}, [ $re, "Gruntmaster::Page::$obj" ] | |
40 | } | |
41 | ||
42 | BEGIN{ | |
43 | my $word = qr,(\w+),a; | |
44 | my $ct = qr,(?:\/ct/$word)?,a; | |
45 | ||
46 | get qr,/css/$word, => 'CSS'; | |
47 | get qr,/js, => 'JS'; | |
48 | ||
49 | get qr,/ct/, => 'Ct'; | |
50 | get qr,/ct/$word, => 'Ct::Entry'; | |
51 | get qr,/us/, => 'Us'; | |
52 | get qr,/us/$word, => 'Us::Entry'; | |
53 | ||
54 | get qr,$ct/log/(\d+)?, => 'Log'; | |
55 | get qr,$ct/log/st, => 'St'; | |
56 | get qr,$ct/log/job/$word, => 'Log::Entry'; | |
57 | get qr,$ct/submit, => 'Submit'; | |
58 | get qr,$ct/pb/, => 'Pb'; | |
59 | get qr,$ct/pb/$word, => 'Pb::Entry'; | |
60 | } | |
61 | ||
62 | 1; | |
63 | __END__ |