Changeset 26689

Show
Ignore:
Timestamp:
12/14/08 23:53:12 (4 years ago)
Author:
masaki
Message:

Routeをmerbっぽくした（だけ）

Location:
lang/perl/HTTP-Router/branches/merb-like/lib/HTTP
Files:
5 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/HTTP-Router/branches/merb-like/lib/HTTP/Router.pm

    r26593 r26689  
    33use 5.8.1; 
    44use Moose; 
    5 use Hash::Merge (); 
    65use HTTP::Router::Mapper; 
    76use HTTP::Router::Routes; 
    … …  
    98our $VERSION = '0.01'; 
    109 
    11 has '_routes' => ( 
     10has 'routeset' => ( 
    1211    is      => 'rw', 
    1312    isa     => 'HTTP::Router::Routes', 
    1413    default => sub { HTTP::Router::Routes->new }, 
    15     handles => { routes => 'all', add_route => 'push' }, 
     14    handles => { routes => 'all' }, 
    1615); 
    1716 
     17sub to_mapper { HTTP::Router::Mapper->new(routeset => shift->routeset) } 
     18 
    1819sub match { 
    19     my ($self, $path, $conditions) = @_; 
    20     return HTTP::Router::Mapper->new( 
    21         routes     => $self->_routes, 
    22         path       => $path, 
    23         conditions => $conditions || {}, 
    24     ); 
     20    my $self = shift; 
     21    return $self->to_mapper->match(@_); 
    2522} 
    2623 
    27 sub connect { 
    28     my ($self, $path, $params) = @_; 
    29  
    30     $params ||= {}; 
    31     my $conditions   = delete $params->{conditions}   || {}; 
    32     my $requirements = delete $params->{requirements} || {}; 
    33     $conditions = Hash::Merge::merge($conditions, $requirements); 
    34  
    35     return $self->match($path, $conditions)->to($params); 
    36 } 
    37  
    38 sub route_for { 
     24sub find { 
    3925    my ( $self, $path, $conditions ) = @_; 
    4026 
    … …  
    6147} 
    6248 
    63 __PACKAGE__->meta->make_immutable; 
    64  
    65 no Moose; 
    66  
    67 1; 
     49no Moose; __PACKAGE__->meta->make_immutable; 
    6850 
    6951=head1 NAME 

  • lang/perl/HTTP-Router/branches/merb-like/lib/HTTP/Router/Mapper.pm

    r26593 r26689  
    22 
    33use Moose; 
     4use MooseX::AttributeHelpers; 
    45use Hash::Merge qw(merge); 
    56use URI::Template; 
    67use HTTP::Router::Route; 
     8use HTTP::Router::Routes; 
    79 
    8 has 'routes' => (is => 'rw', isa => 'HTTP::Router::Routes'); 
    9 has 'path' => (is => 'rw', isa => 'Str'); 
    10 has 'conditions' => (is => 'rw', isa => 'HashRef', default => sub { +{} }); 
     10has 'routeset' => ( 
     11    is       => 'rw', 
     12    isa      => 'HTTP::Router::Routes', 
     13    required => 1, 
     14); 
     15 
     16has 'route' => ( 
     17    is        => 'rw', 
     18    isa       => 'HTTP::Router::Route', 
     19    predicate => 'has_route', 
     20); 
     21 
     22has 'path' => ( 
     23    metaclass => 'String', 
     24    is        => 'rw', 
     25    isa       => 'Str', 
     26    default   => '', 
     27    provides  => { append => 'add_path' }, 
     28); 
     29 
     30has 'conditions' => ( 
     31    is      => 'rw', 
     32    isa     => 'HashRef', 
     33    default => sub { +{} }, 
     34); 
     35 
     36sub add_route { 
     37    my ($self, $route) = @_; 
     38    $self->routeset->push($route); 
     39    $self->route($route); 
     40} 
    1141 
    1242sub match { 
    1343    my ($self, $path, $conditions) = @_; 
     44    return $self if $self->has_route; 
    1445 
    15     $self->path($self->path . $path); 
     46    $self->add_path($path); 
    1647    $self->conditions(merge $self->conditions, $conditions || {}); 
    1748 
    … …  
    2253sub to { 
    2354    my ($self, $params) = @_; 
     55    return $self if $self->has_route; 
    2456 
    2557    my $route = HTTP::Router::Route->new( 
    26         path => URI::Template->new($self->path), 
    27         params => $params || {}, 
     58        path       => URI::Template->new($self->path), 
     59        params     => $params || {}, 
    2860        conditions => $self->conditions, 
    2961    ); 
    30     $self->routes->push($route); 
    3162 
    32     return $route; 
     63    $self->add_route($route); 
     64 
     65    return $self; 
    3366} 
    3467 

  • lang/perl/HTTP-Router/branches/merb-like/lib/HTTP/Router/Match.pm

    r25886 r26689  
    33use Moose; 
    44 
    5 has 'path' => ( 
    6     is       => 'rw', 
    7     isa      => 'Str', 
    8     required => 1, 
    9 ); 
    10  
    115has 'params' => ( 
    126    is       => 'rw', 
    137    isa      => 'HashRef', 
    14     required => 1, 
     8    default  => sub { +{} }, 
     9); 
     10 
     11has 'captures' => ( 
     12    is       => 'rw', 
     13    isa      => 'HashRef', 
    1514    default  => sub { +{} }, 
    1615); 
    1716 
    1817has 'route' => ( 
    19     is       => 'rw', 
    20     isa      => 'HTTP::Router::Route', 
    21     required => 1, 
    22     handles  => ['uri_for'], 
     18    is      => 'rw', 
     19    isa     => 'HTTP::Router::Route', 
     20    handles => ['uri_for'], 
    2321); 
    2422 
    25 __PACKAGE__->meta->make_immutable; 
    26  
    27 no Moose; 
    28  
    29 1; 
     23no Moose; __PACKAGE__->meta->make_immutable; 
    3024 
    3125=for stopwords params 
    … …  
    4135=head1 PROPERTIES 
    4236 
    43 =head2 path 
     37=head2 params 
    4438 
    45 =head2 params 
     39=head2 captures 
    4640 
    4741=head2 route 

  • lang/perl/HTTP-Router/branches/merb-like/lib/HTTP/Router/Route.pm

    r26123 r26689  
    22 
    33use Moose; 
    4 use Moose::Util::TypeConstraints; 
    54use MooseX::AttributeHelpers; 
    6 use List::MoreUtils qw(all true); 
    7 use Storable qw(dclone); 
     5use Hash::Merge qw(merge); 
     6use List::MoreUtils qw(any); 
    87use URI::Template 0.13; 
     8use namespace::clean -except => ['meta']; 
     9 
    910use HTTP::Router::Match; 
    10  
    11 class_type 'URI::Template'; 
    12  
    13 coerce 'URI::Template' => from 'Str' => via { URI::Template->new($_) }; 
    1411 
    1512has 'path' => ( 
    1613    is       => 'rw', 
    17     isa      => 'URI::Template', 
     14    isa      => 'Str', 
    1815    required => 1, 
    19     coerce   => 1, 
     16    trigger  => sub { 
     17        my ($self, $path) = @_; 
     18        $self->parts([ split m!/! => $path ]); 
     19        $self->templates(URI::Template->new($path)); 
     20    }, 
     21); 
     22 
     23has 'parts' => ( 
     24    metaclass => 'Collection::Array', 
     25    is        => 'rw', 
     26    isa       => 'ArrayRef[Str]', 
     27    provides  => { count => 'part_size' }, 
     28); 
     29 
     30has 'templates' => ( 
     31    is      => 'rw', 
     32    isa     => 'URI::Template', 
     33    handles => ['variables'], 
    2034); 
    2135 
    … …  
    2741 
    2842has 'conditions' => ( 
    29     is      => 'rw', 
    30     isa     => 'HashRef[ Str | RegexpRef | ArrayRef ]', 
    31     default => sub { +{} }, 
     43    metaclass => 'Collection::Hash', 
     44    is        => 'rw', 
     45    isa       => 'HashRef[ Str | RegexpRef | ArrayRef ]', 
     46    default   => sub { +{} }, 
     47    provides  => { get => 'condition_for', keys => 'all_condition_names' }, 
    3248); 
    3349 
    34 has 'requirements' => ( 
    35     is      => 'rw', 
    36     isa     => 'HashRef[ Str | RegexpRef | ArrayRef ]', 
    37     default => sub { +{} }, 
    38 ); 
     50sub condition_names { 
     51    my $self = shift; 
     52    my @all = $self->all_condition_names; 
     53    my @var = $self->variables; 
     54    require Array::Diff; 
     55    return @{ Array::Diff->diff(\@all, \@var)->deleted }; 
     56} 
    3957 
    40 sub slashes { 
    41     return scalar @{[ shift->path->as_string =~ m!/!g ]}; 
     58sub validate { 
     59    my ($self, $input, $expected) = @_; 
     60    return 1                               unless defined $expected; 
     61    return $input =~ $expected             if ref $expected eq 'Regexp'; 
     62    return any { $input eq $_ } @$expected if ref $expected eq 'ARRAY'; 
     63    return $input eq $expected; 
    4264} 
    4365 
    … …  
    4567    my ($self, $path, $conditions) = @_; 
    4668 
    47     # check slashes 
    48     return unless $self->_check_slashes($path); 
    49     # check path 
    50     return unless $path eq $self->path->as_string; 
    51     # check conditions 
    52     return unless $self->_check_conditions($conditions); 
     69    # part size 
     70    my $size = scalar split m!/! => $path; 
     71    return unless $size == $self->part_size; 
    5372 
    54     return $self->_build_match($path, dclone $self->params); 
    55 } 
    56  
    57 sub match_with_expansions { 
    58     my ($self, $path, $conditions) = @_; 
    59  
    60     # check slashes 
    61     return unless $self->_check_slashes($path); 
    62     # check path 
    63     my %captures = $self->path->deparse($path); 
    64     return unless all { defined } values %captures; 
    65     # check requirements 
    66     return unless $self->_check_requirements(\%captures); 
    67     # check conditions 
    68     return unless $self->_check_conditions($conditions); 
    69  
    70     my $params = dclone $self->params; 
    71     $params = { %$params, %captures }; 
    72  
    73     return $self->_build_match($path, $params); 
    74 } 
    75  
    76 sub uri_for { 
    77     my ($self, $args) = @_; 
    78  
    79     my $params = $args || {}; 
    80  
    81     if ($self->path->variables > 0) { 
    82         return unless $self->_check_requirements($params); 
     73    # path, captures 
     74    my %captures = $self->templates->deparse($path); 
     75    if (%captures) { 
     76        return unless $self->check_captures(\%captures); 
     77    } 
     78    else { 
     79        return unless $path eq $self->path; 
    8380    } 
    8481 
    85     return $self->path->process_to_string(%$params); 
    86 } 
    87  
    88 sub _build_match { 
    89     my ($self, $path, $params) = @_; 
     82    # conditions 
     83    return unless $self->check_conditions($conditions); 
    9084 
    9185    return HTTP::Router::Match->new( 
    92         path   => $path, 
    93         params => $params, 
    94         route  => $self, 
     86        params   => merge($self->params, \%captures), 
     87        captures => \%captures, 
     88        route    => $self, 
    9589    ); 
    9690} 
    9791 
    98 sub _check_slashes { 
    99     my ($self, $path) = @_; 
    100     return scalar @{[ $path =~ m!/!g ]} == $self->slashes; 
    101 } 
     92sub check_captures { 
     93    my ($self, $captures) = @_; 
    10294 
    103 sub _check_requirements { 
    104     my ($self, $args) = @_; 
    105  
    106     # not exists 
    107     return 1 unless keys %{ $self->requirements } > 0; 
    108     # not supplied 
    109     return unless defined $args and keys %$args > 0; 
    110  
    111     # check 
    112     while (my ($key, $value) = each %$args) { 
    113         next unless exists $self->requirements->{$key}; 
    114         return unless $self->_validate($value, $self->requirements->{$key}); 
     95    for my $name (keys %$captures) { 
     96        next     unless my $expected = $self->condition_for($name); 
     97        return 0 unless $self->validate($captures->{$name}, $expected); 
    11598    } 
    11699 
    … …  
    118101} 
    119102 
    120 sub _check_conditions { 
    121     my ($self, $args) = @_; 
     103sub check_conditions { 
     104    my ($self, $conditions) = @_; 
    122105 
    123     # not exists 
    124     return 1 unless my @keys = keys %{ $self->conditions }; 
    125     # not supplied 
    126     return unless defined $args and keys %$args > 0; 
    127  
    128     # check 
    129     for my $key (@keys) { 
    130         return unless exists $args->{$key}; 
    131         return unless $self->_validate($args->{$key}, $self->conditions->{$key}); 
     106    for my $name ($self->condition_names) { 
     107        return 0 unless my $input = $conditions->{$name}; 
     108        return 0 unless $self->validate($input, $self->condition_for($name)); 
    132109    } 
    133110 
    … …  
    135112} 
    136113 
    137 sub _validate { 
    138     my ($self, $input, $expected) = @_; 
    139  
    140     return $input =~ $expected              if ref $expected eq 'Regexp'; 
    141     return true { $input eq $_ } @$expected if ref $expected eq 'ARRAY'; 
    142     return $input eq $expected; 
     114sub uri_for { 
     115    my ($self, $args) = @_; 
     116    return $self->templates->process_to_string(%{ $args || {} }); 
    143117} 
    144118 
    145 __PACKAGE__->meta->make_immutable; 
    146  
    147 no Moose; 
    148  
    149 1; 
     119no Moose; __PACKAGE__->meta->make_immutable; 
    150120 
    151121=for stopwords params 
    … …  
    159129=head2 match($path, $conditions) 
    160130 
    161 =head2 match_with_expansions($path, $conditions) 
    162  
    163131=head2 uri_for($args) 
    164132 
    … …  
    167135=head2 path 
    168136 
    169 =head2 slashes 
     137=head2 templates 
     138 
     139=head2 variables 
     140 
     141=head2 parts 
     142 
     143=head2 part_size 
    170144 
    171145=head2 params 
    … …  
    173147=head2 conditions 
    174148 
    175 =head2 requirements 
     149=head2 condition_names 
     150 
     151=head1 INTERNALS 
     152 
     153=head2 validate 
     154 
     155=head2 check_captures 
     156 
     157=head2 check_conditions 
     158 
     159=head2 condition_for 
    176160 
    177161=head1 AUTHOR 

  • lang/perl/HTTP-Router/branches/merb-like/lib/HTTP/Router/Routes.pm

    r26593 r26689  
    22 
    33use Moose; 
     4use MooseX::AttributeHelpers; 
    45use HTTP::Router::Route; 
    56 
    6 has '_routes' => ( 
    7     is => 'rw', 
    8     isa => 'ArrayRef[HTTP::Router::Route]', 
    9     default => sub { [] }, 
     7has 'routes' => ( 
     8    metaclass => 'Collection::Array', 
     9    is        => 'rw', 
     10    isa       => 'ArrayRef[HTTP::Router::Route]', 
     11    default   => sub { [] }, 
     12    provides  => { elements => 'all', push => 'push' }, 
    1013); 
    1114 
    12 sub all { 
    13     my $self = shift; 
    14     return @{ $self->_routes }; 
    15 } 
    16  
    17 sub push { 
    18     my ($self, $route) = @_; 
    19     CORE::push @{ $self->_routes }, $route; 
    20 } 
    21  
    2215no Moose; __PACKAGE__->meta->make_immutable;