The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Clustericious::RouteBuilder;

use strict;
use warnings;
use 5.010;
use Log::Log4perl qw( :easy );

# ABSTRACT: Route builder for Clustericious applications
our $VERSION = '0.9941'; # VERSION


our %Routes;

# Much of the code below taken directly from Mojolicious::Lite.
sub import {
    my $class = shift;
    my $caller = caller;
    my $app_class;
    if (@_) { # allow specification in the "use".
        $app_class = shift;
    } elsif ($caller->isa("Clustericious::App")) {
        $app_class = $caller;
    } else {
        $app_class = $caller;
        $app_class =~ s/::Routes$// or die "could not guess app class : ";
    }
    my @routes;
    $Routes{$app_class} = \@routes;

    # Route generator
    my $route_sub = sub {
        my ($methods, @args) = @_;

        my ($cb, $constraints, $defaults, $name, $pattern);
        my $conditions = [];

        # Route information
        my $condition;
        while (my $arg = shift @args) {

            # Condition can be everything
            if ($condition) {
                push @$conditions, $condition => $arg;
                $condition = undef;
            }

            # First scalar is the pattern
            elsif (!ref $arg && !$pattern) { $pattern = $arg }

            # Scalar
            elsif (!ref $arg && @args) { $condition = $arg }

            # Last scalar is the route name
            elsif (!ref $arg) { $name = $arg }

            # Callback
            elsif (ref $arg eq 'CODE') { $cb = $arg }

            # Constraints
            elsif (ref $arg eq 'ARRAY') { $constraints = $arg }

            # Defaults
            elsif (ref $arg eq 'HASH') { $defaults = $arg }
        }

        # Defaults
        $cb ||= sub {1};
        $constraints ||= [];

        # Merge
        $defaults ||= {};
        $defaults = {%$defaults, cb => $cb};

        # Name
        $name ||= '';

        push @routes, {
            name        => $name,
            pattern     => $pattern,
            constraints => $constraints,
            conditions  => $conditions,
            defaults    => $defaults,
            methods     => $methods
          };

    };

    # Prepare exports
    no strict 'refs';
    no warnings 'redefine';

    # Export
    *{"${caller}::any"}          = sub { $route_sub->(ref $_[0] ? shift : [], @_) };
    *{"${caller}::get"}          = sub { $route_sub->('get', @_) };
    *{"${caller}::head"}         = sub { $route_sub->('head', @_) };
    *{"${caller}::ladder"}       = sub { $route_sub->('ladder', @_) };
    *{"${caller}::post"}         = sub { $route_sub->('post', @_) };
    *{"${caller}::put"}          = sub { $route_sub->('put', @_) };
    *{"${caller}::Delete"}       = sub { $route_sub->('delete', @_) };
    *{"${caller}::del"}          = sub { $route_sub->('delete', @_) };
    *{"${caller}::websocket"}    = sub { $route_sub->('websocket', @_) };
    *{"${caller}::authenticate"} = sub { $route_sub->('authenticate',@_) };
    *{"${caller}::authorize"}    = sub { $route_sub->('authorize',@_) };
}

sub _add_routes {
    my $class = shift;
    my $app = shift;
    my $auth_plugin = shift;

    my $stashed = $Routes{ ref $app } // do { WARN "no routes stashed for $app"; [] };
    my @stashed            = @$stashed;
    my $routes             = $app->routes;
    my $head_route         = $app->routes;
    my $head_authenticated = $head_route;

    for my $spec (@stashed) {
       my      ($name,$pattern,$constraints,$conditions,$defaults,$methods) =
       @$spec{qw/name  pattern  constraints  conditions  defaults  methods/};

         # authenticate, always connects to app->routes
         if (!ref $methods && $methods eq 'authenticate') {
             my $realm = $pattern || ref $app;
             my $cb = defined $auth_plugin ? sub { $auth_plugin->authenticate(shift, $realm) } : sub { 1 };
             $head_route = $head_authenticated = $routes =
             $app->routes->bridge->to( { cb => $cb } )->name("authenticated");
             next;
         }

         # authorize replaces previous authorize's
         if (!ref $methods && $methods eq 'authorize') {
            die "put authenticate before authorize" unless $head_authenticated;
            my $action = $pattern;
            my $resource = $name;
            if($auth_plugin)
            {
                $head_route = $routes = $head_authenticated->bridge->to( {
                        cb => sub {
                            my $c = shift;
                            # Dynamically compute resource/action
                            my ($d_resource,$d_action) = ($resource, $action);
                            $d_resource =~ s/<path>/$c->req->url->path/e if $d_resource;
                            $d_resource ||= $c->req->url->path;
                            $d_action =~ s/<method>/$c->req->method/e if $d_action;
                            $d_action ||= $c->req->method;
                            $auth_plugin->authorize( $c, $d_action, $d_resource );
                          } });
            }
            else
            {
                $head_route = $routes = $head_authenticated->bridge->to({ cb => sub { 1 } });
            }
            next;
         }

         # ladders don't replace previous ladders
         if (!ref $methods && $methods eq 'ladder') {
              die "constraints not handled in ladders" if $constraints && @$constraints;
              $routes = $routes->bridge( $pattern )->over($conditions)
                  ->to($defaults)->name($name);
              next;
         }

         # WebSocket?
         my $websocket = 1 if !ref $methods && $methods eq 'websocket';
         $methods = [] if $websocket;

         # Create route
         my $route =
           $routes->route( $pattern, @$constraints )->over($conditions)
           ->via($methods)->to($defaults)->name($name);

         # WebSocket
         $route->websocket if $websocket;
     }
}

1;


__END__
=pod

=head1 NAME

Clustericious::RouteBuilder - Route builder for Clustericious applications

=head1 VERSION

version 0.9941

=head1 SYNOPSIS

 package MyApp;
 
 use Mojo::Base qw( Clustericious::App );
 
 package MyApp::Routes;

 use Clustericious::RouteBuilder;
 
 get '/' => sub { shift->render(text => 'welcome to myapp') };

=head1 DESCRIPTION

This module provides a simplified interface for creating routes for your 
L<Clustericious> application.  To use it, create a Routes.pm that lives 
directly under your application's namespace (for example above MyApp's 
route module is MyApp::Routes).  The interface is reminiscent of 
L<Mojolicious::Lite>, because it was forked from there some time ago.

=head1 SUPER CLASS

none

=head1 METHODS

=head2 any

Define an HTTP route that matches any HTTP command verb.

=head2 get

Define an HTTP GET route

=head2 head

Define an HTTP HEAD route

=head2 post

Define an HTTP POST route

=head2 put

Define an HTTP PUT route

=head2 del

Define an HTTP DELETE route.

=head2 websocket

Define a Websocket route.

=head2 authenticate

Require authentication for all subsequent routes.

=head2 authorize [ $action ]

Require specific authorization for all subsequent routes.

=head1 SEE ALSO

L<Clustericious>, L<Mojolicious::Lite>

=head1 AUTHOR

original author: Brian Duggan

current maintainer: Graham Ollis <plicease@cpan.org>

contributors:

Curt Tilmes

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by NASA GSFC.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut