initial checkin

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..36686dd
--- /dev/null
+++ b/Changes
@@ -0,0 +1,3 @@
+0.01
+
+- First release upon an unsuspecting world.

diff --git a/dist.ini b/dist.ini
new file mode 100644 (file)
index 0000000..cac585c
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,38 @@
+name    = CatalystX-Routes
+author  = Dave Rolsky <autarch@urth.org>
+license = Artistic_2_0
+copyright_holder = Dave Rolsky
+copyright_year   = 2011
+
+version = 0.01
+
+[@Basic]
+
+[InstallGuide]
+[MetaJSON]
+
+[MetaResources]
+bugtracker.web    = http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-Routes
+bugtracker.mailto = bug-catalystx-routes@rt.cpan.org
+repository.url    = http://hg.urth.org/hg/CatalystX-Routes
+repository.web    = http://hg.urth.org/hg/CatalystX-Routes
+repository.type   = hg
+
+[SurgicalPodWeaver]
+
+[PkgVersion]
+
+[PodSyntaxTests]
+[PodCoverageTests]
+[NoTabsTests]
+[EOLTests]
+[Signature]
+
+[CheckChangeLog]
+
+[Prereqs]
+
+[Prereqs / TestRequires]
+Test::More = 0.88
+
+[@Mercurial]

diff --git a/lib/CatalystX/Routes.pm b/lib/CatalystX/Routes.pm
new file mode 100644 (file)
index 0000000..0d7f6b9
--- /dev/null
+++ b/lib/CatalystX/Routes.pm
@@ -0,0 +1,134 @@
+package CatalystX::Routes;
+
+use strict;
+use warnings;
+
+use CatalystX::Routes::Role::Class;
+use CatalystX::Routes::Role::Controller;
+use Moose::Util qw( apply_all_roles );
+use Params::Util qw( _STRING _CODELIKE );
+use Scalar::Util qw( blessed );
+
+use Moose::Exporter;
+
+Moose::Exporter->setup_import_methods(
+    with_meta => [qw( get get_html post put del )],
+    as_is     => [qw( chained args capture_args path_part action )],
+    class_metaroles => {
+        class => ['CatalystX::Routes::Role::Class'],
+    },
+);
+
+sub get {
+    _add_route( 'GET', @_ );
+}
+
+sub get_html {
+    _add_route( 'GET_html', @_ );
+}
+
+sub post {
+    _add_route( 'POST', @_ );
+}
+
+sub put {
+    _add_route( 'PUT', @_ );
+}
+
+sub del {
+    _add_route( 'DELETE', @_ );
+}
+
+sub _add_route {
+    my $rest = shift;
+    my $meta = shift;
+    my ( $name, $attrs, $sub ) = _process_args(@_);
+
+    my $meth_base = '__route__' . $name;
+
+    _maybe_add_rest_route( $meta, $meth_base, $attrs );
+
+    my $meth_name = $meth_base . q{_} . $rest;
+
+    $meta->add_method( $meth_name => sub { goto &$sub } );
+
+    return;
+}
+
+sub path_part ($) {
+    return ( PathPart => [ $_[0] ] );
+}
+
+sub chained ($) {
+    return ( Chained => [ $_[0] ] );
+}
+
+sub args ($) {
+    return ( Args => [ $_[0] ] );
+}
+
+sub capture_args ($) {
+    return ( CaptureArgs => [ $_[0] ] );
+}
+
+sub action ($) {
+    return ( ActionClass => [ $_[0] ] );
+}
+
+sub _process_args {
+    my $path = shift;
+    my $sub  = pop;
+
+    my $caller = ( caller(2) )[3];
+
+    die
+        "The $caller keyword expects a path string or regex as its first argument"
+        unless _STRINGLIKE0($path) || _REGEX($path);
+
+    die "The $caller keyword expects a sub ref as its final argument"
+        unless _CODELIKE($sub);
+
+    my %p = @_;
+
+    $p{ActionClass} ||= 'REST';
+
+    ( my $name = $path ) =~ s/(\W)/'X' . sprintf( '%x', ord($1) )/eg;
+
+    return $name, \%p, $sub;
+}
+
+sub _maybe_add_rest_route {
+    my $meta  = shift;
+    my $name  = shift;
+    my $attrs = shift;
+
+    return if $meta->has_method($name);
+
+    # This could be done by Moose::Exporter, but that would require that the
+    # module has already inherited from Cat::Controller when it calls "use
+    # CatalystX::Routes".
+    unless ( $meta->does_role('CatalystX::Routes::Role::Controller') ) {
+        apply_all_roles(
+            $meta->name(),
+            'CatalystX::Routes::Role::Controller'
+        );
+    }
+
+    $meta->add_method( $name => sub { } );
+
+    $meta->add_route( $name => [ $attrs, $meta->get_method($name) ] );
+
+    return;
+}
+
+# XXX - this should be added to Params::Util
+sub _STRINGLIKE0 ($) {
+    return _STRING( $_[0] )
+        || ( defined $_[0]
+        && $_[0] eq q{} )
+        || ( blessed $_[0]
+        && overload::Method( $_[0], q{""} )
+        && length "$_[0]" );
+}
+
+1;

diff --git a/lib/CatalystX/Routes/Role/Class.pm b/lib/CatalystX/Routes/Role/Class.pm
new file mode 100644 (file)
index 0000000..82ab047
--- /dev/null
+++ b/lib/CatalystX/Routes/Role/Class.pm
@@ -0,0 +1,16 @@
+package CatalystX::Routes::Role::Class;
+
+use Moose::Role;
+use namespace::clean -except => 'meta';
+
+has _routes => (
+    traits  => ['Hash'],
+    isa     => 'HashRef[ArrayRef]',
+    handles => {
+        add_route   => 'set',
+        get_route   => 'get',
+        route_names => 'keys',
+    },
+);
+
+1;

diff --git a/lib/CatalystX/Routes/Role/Controller.pm b/lib/CatalystX/Routes/Role/Controller.pm
new file mode 100644 (file)
index 0000000..e62a212
--- /dev/null
+++ b/lib/CatalystX/Routes/Role/Controller.pm
@@ -0,0 +1,44 @@
+package CatalystX::Routes::Role::Controller;
+
+use Moose::Role;
+use namespace::clean -except => 'meta';
+
+requires 'register_actions';
+
+after register_actions => sub {
+    my $self = shift;
+    my $c    = shift;
+
+    my $class     = $self->catalyst_component_name;
+    my $namespace = $self->action_namespace($c);
+
+    for my $route ( $self->meta()->route_names() ) {
+        my ( $attrs, $method ) = @{ $self->meta()->get_route($route) };
+
+        for my $key ( keys %{$attrs} ) {
+            my $parse_meth = "_parse_${key}_attr";
+
+            next unless $self->can($parse_meth);
+
+            ( undef, my $value )
+                = $self->$parse_meth( $c, $route, $attrs->{$key} );
+
+            $attrs->{$key} = [$value];
+        }
+
+        my $reverse = $namespace ? "${namespace}/$route" : $route;
+
+        my $action = $self->create_action(
+            name       => $route,
+            code       => $method->body(),
+            reverse    => $reverse,
+            namespace  => $namespace,
+            class      => $class,
+            attributes => $attrs,
+        );
+
+        $c->dispatcher->register( $c, $action );
+    }
+};
+
+1;

diff --git a/t/lib/MyApp1.pm b/t/lib/MyApp1.pm
new file mode 100644 (file)
index 0000000..90660d4
--- /dev/null
+++ b/t/lib/MyApp1.pm
@@ -0,0 +1,8 @@
+package MyApp1;
+
+use Moose;
+use Catalyst;
+
+extends 'Catalyst';
+
+__PACKAGE__->setup();

diff --git a/t/lib/MyApp1/Controller/C1.pm b/t/lib/MyApp1/Controller/C1.pm
new file mode 100644 (file)
index 0000000..9aeaba7
--- /dev/null
+++ b/t/lib/MyApp1/Controller/C1.pm
@@ -0,0 +1,24 @@
+package MyApp1::Controller::C1;
+
+use Moose;
+use CatalystX::Routes;
+
+extends 'Catalyst::Controller';
+
+sub _get      { }
+sub _get_html { }
+sub _post     { }
+sub _put      { }
+sub _del      { }
+
+get '/foo' => \&_get;
+
+get_html '/foo' => \&_get_html;
+
+post '/foo' => \&_post;
+
+put '/foo' => \&_put;
+
+del '/foo' => \&_del;
+
+1;

diff --git a/t/routes.t b/t/routes.t
new file mode 100644 (file)
index 0000000..ef7c160
--- /dev/null
+++ b/t/routes.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use Test::More 0.88;
+
+use lib 't/lib';
+use MyApp1;
+
+my $app = MyApp1->new();
+
+ok( $app, 'instantiated MyApp1' );
+
+my $action = $app->dispatcher()->get_action('/foo');
+
+ok( $action, 'got an action for /foo' );
+
+
+done_testing();