1package Router::Simple::Sinatraish; 2use strict; 3use warnings; 4use parent qw/Exporter/; 5use 5.00800; 6our $VERSION = '0.03'; 7use Router::Simple; 8 9our @EXPORT = qw/router any get post/; 10 11sub router { 12 my $class = shift; 13 no strict 'refs'; 14 no warnings 'once'; 15 ${"${class}::ROUTER"} ||= Router::Simple->new(); 16} 17 18# any [qw/get post delete/] => '/bye' => sub { ... }; 19# any '/bye' => sub { ... }; 20sub any($$;$) { 21 my $pkg = caller(0); 22 if (@_==3) { 23 my ($methods, $pattern, $code) = @_; 24 $pkg->router->connect( 25 $pattern, 26 {code => $code}, 27 { method => [ map { uc $_ } @$methods ] } 28 ); 29 } else { 30 my ($pattern, $code) = @_; 31 $pkg->router->connect( 32 $pattern, 33 {code => $code}, 34 ); 35 } 36} 37 38sub get { 39 my $pkg = caller(0); 40 $pkg->router->connect($_[0], {code => $_[1]}, {method => ['GET', 'HEAD']}); 41} 42sub post { 43 my $pkg = caller(0); 44 $pkg->router->connect($_[0], {code => $_[1]}, {method => ['POST']}); 45} 46 471; 48__END__ 49 50=encoding utf8 51 52=head1 NAME 53 54Router::Simple::Sinatraish - Sinatra-ish routers on Router::Simple 55 56=head1 SYNOPSIS 57 58 package MySinatraishFramework; 59 use Router::Simple::Sinatraish; 60 61 sub import { 62 Router::Simple::Sinatraish->export_to_level(1); 63 } 64 65 sub to_app { 66 my ($class) = caller(0); 67 sub { 68 my $env = shift; 69 if (my $route = $class->router->match($env)) { 70 return $route->{code}->($env); 71 } else { 72 return [404, [], ['not found']]; 73 } 74 }; 75 } 76 77 package MyApp; 78 use MySinatraishFramework; 79 80 get '/' => sub { 81 [200, [], ['ok']]; 82 }; 83 post '/edit' => sub { 84 [200, [], ['ok']]; 85 }; 86 any '/any' => sub { 87 [200, [], ['ok']]; 88 }; 89 90 __PACKAGE__->to_app; 91 92=head1 DESCRIPTION 93 94Router::Simple::Sinatraish is toolkit library for sinatra-ish WAF. 95 96=head1 EXPORTABLE METHODS 97 98=over 4 99 100=item my $router = YourClass->router; 101 102Returns this instance of L<Router::Simple>. 103 104=back 105 106=head1 EXPORTABLE FUNCTIONS 107 108=over 4 109 110=item get($path:Str, $code:CodeRef) 111 112 get '/' => sub { ... }; 113 114Add new route, handles GET method. 115 116=item post($path:Str, $code:CodeRef) 117 118 post '/' => sub { ... }; 119 120Add new route, handles POST method. 121 122=item any($path:Str, $code:CodeRef) 123 124 any '/' => sub { ... }; 125 126Add new route, handles any HTTP method. 127 128=item any($methods:ArrayRef[Str], $path:Str, $code:CodeRef) 129 130 any [qw/GET DELETE/] => '/' => sub { ... }; 131 132Add new route, handles any HTTP method. 133 134=back 135 136=head1 AUTHOR 137 138Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt> 139 140=head1 SEE ALSO 141 142L<Router::Simple> 143 144=head1 LICENSE 145 146Copyright (C) Tokuhiro Matsuno 147 148This library is free software; you can redistribute it and/or modify 149it under the same terms as Perl itself. 150 151=cut 152