lib/Catalyst/DispatchType/Route.pm

   1 package Catalyst::DispatchType::Route;
   2
   3 use strict;
   4 use base qw/Catalyst::DispatchType/;
   5 use Text::SimpleTable;
   6 use URI;
   7
   8 use Catalyst::DispatchType::RouteMapper;
   9
  10 =head1 NAME
  11
  12 Catalyst::DispatchType::Route - RoR Route DispatchType
  13
  14 =head1 SYNOPSIS
  15
  16 See L<Catalyst>.
  17
  18 =head1 DESCRIPTION
  19
  20 =head1 METHODS
  21
  22 =head2 $self->list($c)
  23
  24 Debug output for Route dispatch points
  25
  26 =cut
  27
  28 sub list {
  29     my ( $self, $c ) = @_;
  30     my $paths = Text::SimpleTable->new( [ 35, 'Route' ], [ 36, 'Private' ] );
  31     foreach my $path ( sort keys %{ $self->{routes} } ) {
  32         my $display_path = $path eq '/' ? $path : "/$path";
  33         $paths->row( $display_path, "/" . $self->{routes}->{$path} );
  34     }
  35     $c->log->debug( "Loaded Route actions:\n" . $paths->draw . "\n" )
  36       if ( keys %{ $self->{routes} } );
  37 }
  38
  39 =head2 $self->match( $c, $path )
  40
  41 For each action registered to this exact path, offers the action a chance to
  42 match the path (in the order in which they were registered). Succeeds on the
  43 first action that matches, if any; if not, returns 0.
  44
  45 =cut
  46
  47 sub match {
  48     my ( $self, $c, $path ) = @_;
  49
  50     return 0 if @{ $c->req->args };
  51
  52     $path ||= '/';
  53     use Data::Dumper;
  54
  55     #$c->log->debug('path=' . $path);
  56     #$c->log->debug('ehre' . Dumper($self->{routes} ));
  57
  58     my $mapper = $self->{mapper};
  59     if (my $route = $mapper->parse($path)) {
  60         #$c->log->debug('FOUDN!!! route=' . $route);
  61
  62         if (my $action = $self->{routes}->{$route}) {;
  63             #$c->log->debug('ACTION!');
  64             $c->req->action($path);
  65             $c->req->match($path);
  66             $c->action($action);
  67             $c->namespace( $action->namespace );
  68
  69             if (my $params = $mapper->getParams()) {
  70                 while (my($key, $val) = each %$params ) {
  71                     $c->req->param( $key => $val);
  72                 }
  73             }
  74
  75             return 1;
  76         }
  77     }
  78
  79     return 0;
  80 }
  81
  82 =head2 $self->register( $c, $action )
  83
  84 Calls register_path for every Path attribute for the given $action.
  85
  86 =cut
  87
  88 sub register {
  89     my ( $self, $c, $action ) = @_;
  90
  91     my @register = @{ $action->attributes->{Route} || [] };
  92
  93     $self->register_route( $c, $_, $action ) for @register;
  94
  95     return 1 if @register;
  96     return 0;
  97 }
  98
  99 =head2 $self->register_path($c, $path, $action)
 100
 101 Registers an action at a given path.
 102
 103 =cut
 104
 105 sub register_route {
 106     my ( $self, $c, $route, $action ) = @_;
 107
 108     #$c->log->debug( 'path=' . $route . ' action=' . $action );
 109
 110     $self->{mapper} ||= Catalyst::DispatchType::RouteMapper->new();
 111
 112     my $mapper = $self->{ mapper };
 113
 114     $self->{routes} ||= {};
 115
 116     $route = $action->namespace . '/' . $route unless $route =~ s/^\///o;
 117
 118     my $map = {};
 119
 120     my @vars = split('/', $route);
 121     my @new_vars = ();
 122     foreach my $var ( @vars ) {
 123         if ( $var =~ m/^\:(.*?)(?:\|(.*?)\|)?(\=(\?)?(.*))?$/o ) {
 124             my $name       = $1;
 125             my $constraint = $2;
 126             my $extra      = $3;
 127
 128             $var = ":$name";
 129
 130             $map->{ constraints }->{ $name } = $constraint if $constraint;
 131
 132             if ( $extra ) {
 133                 my $isdefault = $4;
 134                 my $val       = $5;
 135
 136                 $map->{ defaults }->{ $name } = $val if $isdefault && $val;
 137                 $map->{ params }->{ $name } = $isdefault
 138                                                 ? undef
 139                                                 : $val || undef;
 140             }
 141         }
 142
 143         push @new_vars, $var;
 144     }
 145
 146     $route = join('/', @new_vars);
 147     $self->{routes}->{$route} = $action;
 148
 149     $map->{ path } = $route;
 150     $mapper->addMap($map);
 151
 152     #use Data::Dumper;
 153
 154     #$c->log->debug(Dumper($map));
 155
 156     return 1;
 157 }
 158
 159 =head2 $self->uri_for_action($action, $captures)
 160
 161 get a URI part for an action; always returns undef is $captures is set
 162 since Path actions don't have captures
 163
 164 =cut
 165
 166 sub uri_for_action {
 167     my ( $self, $action, $captures ) = @_;
 168
 169     return undef if @$captures;
 170
 171     if (my $paths = $action->attributes->{Path}) {
 172         my $path = $paths->[0];
 173         $path = '/' unless length($path);
 174         $path = "/${path}" unless ($path =~ m/^\//);
 175         $path = URI->new($path)->canonical;
 176         return $path;
 177     } else {
 178         return undef;
 179     }
 180 }
 181
 182 =head1 AUTHOR
 183
 184 vti
 185
 186 =head1 COPYRIGHT
 187
 188 This program is free software, you can redistribute it and/or modify it under
 189 the same terms as Perl itself.
 190
 191 =cut
 192
 193 1;