ASP4x-Router

 view release on metacpan or  search on metacpan

lib/ASP4x/Router.pm  view on Meta::CPAN


package ASP4x::Router;

use strict;
use warnings 'all';
use base 'ASP4::RequestFilter';
BEGIN {
  # Only conditionally inherit from ASP4::TransHandler':
  eval { require ASP4::TransHandler };
  push @ASP4x::Router::ISA, 'ASP4::TransHandler' unless $@;
}
use Router::Generic;
use ASP4::ConfigLoader;
use vars __PACKAGE__->VARS;

our $VERSION = '0.022';

our %routers = ( );


sub handler : method
{
  my ($class, $r) = @_;
  
  return -1 if $r->pnotes('__routed');
  $r->pnotes( __routed => 1 );
  
  my $res = $class->SUPER::handler( $r );
  my $Config = ASP4::ConfigLoader->load;
  
  if( my $app = eval { $Config->app } )
  {
    map {
      $Config->load_class( $_ );
      $_->import;
    } @$app;
  }# end if()
  
  my $router = $class->get_router();
  $r->pnotes( route => $router->route_for( $r->uri, $r->method ) );
  
  my $fullpath = $r->document_root . $r->uri;
  if( $fullpath =~ m{/$} && -f $fullpath . 'index.asp' )
  {
    $r->uri( $r->uri . 'index.asp' );
    return -1;
  }
  elsif( -f $fullpath )
  {
    return -1;
  }
  elsif( $r->uri =~ m{^/handlers/} )
  {
    (my $handler_path = $r->uri) =~ s{\.}{/}g;
    $handler_path = $Config->web->application_root . "$handler_path.pm";
    if( -f $handler_path )
    {
      return -1;
    }# end if()
  }# end if()
  
  return $res unless $router;
  
  my @matches = $router->match( $r->uri . ( $r->args ? '?' . $r->args : '' ), $r->method )
    or return -1;
  
  # TODO: Check matches to see if maybe they point to another route not on disk:
  my ($new_uri) = grep {
    my ($path) = split /\?/, $_;
    if( m{^/handlers/} )
    {
      $path =~ s/\./\//g;
      $path .= ".pm";
      if( -f $Config->web->application_root . $path )
      {
        1;
      }# end if()
    }
    else
    {
      -f ($r->document_root . $path);
    }# end if()
  } @matches
    or return -1;
  
  # Require a trailing '/' on the end of the URI:
  unless( $r->uri =~ m{\.[^/]+$} || $r->uri =~ m{/$} )
  {
    my $loc = $r->uri . '/';
    if( $r->args )
    {
      $loc .= "?" . $r->args;
    }# end if()
    $r->status( 301 );
    $r->err_headers_out->add( Location => $loc );
    return 301;
  }# end unless()

  my ($uri, $args) = split /\?/, $new_uri;
  my @args = split /&/, $args if defined($args) && length($args);
  $r->args( join '&', @args );
  $ENV{QUERY_STRING} = $r->args;
  $r->uri( $uri );
  
  return -1;
}# end handler()


sub run
{
  my ($s, $context) = @_;
  
  if( my $route = $context->r->pnotes('route') )
  {
    $Stash->{route} = $route;
  }# end if()
  return $Response->Declined if $context->r->pnotes('__routed');
  
  if( my $app = eval { $Config->app } )
  {
    map {
      $Config->load_class( $_ ); 
      $_->import
    } @$app;
  }# end if()
  
  my $router = $s->get_router()
    or return $Response->Declined;
  
  my ($uri) = split /\?/, $ENV{REQUEST_URI};
  my $route = $router->route_for( $uri, $ENV{REQUEST_METHOD} );
  $Stash->{route} = $route;
  
  my $r = $context->r;
  my $path = $r->document_root . $r->uri;
  if( $path =~ m{/$} && -f $path . 'index.asp' )
  {
    return $Response->Declined;
  }
  elsif( -f $path )
  {
    return $Response->Declined;
  }
  elsif( $r->uri =~ m{^/handlers/} )
  {
    # Check to see if there is a handler on-disk that matches the uri:
    (my $handler_path = $r->uri) =~ s{\.}{/}g;
    $handler_path = $Config->web->application_root . "$handler_path.pm";
    if( -f $handler_path )
    {
      return $Response->Declined;
    }# end if()
  }# end if()

  # Try routing:
  if( my @matches = $router->match( $ENV{REQUEST_URI}, $ENV{REQUEST_METHOD} ) )
  {
    # TODO: Check matches to see if maybe they point to another route not on disk:
    my ($new_uri) = grep {
      my ($path) = split /\?/, $_;
      if( $path =~ m{^/handlers/} )
      {
        $path =~ s/\./\//g;
        $path .= ".pm";
        -f $Config->web->application_root . $path;
      }
      else
      {
        -f $Server->MapPath($path);
      }# end if()
    } @matches or return $Response->Declined;
    
    $Stash->{route} = $router->route_for( $ENV{REQUEST_URI}, $ENV{REQUEST_METHOD} );
    $Request->Reroute( $new_uri );
  }
  else
  {
    return $Response->Declined;
  }# end if()



( run in 0.762 second using v1.01-cache-2.11-cpan-98e64b0badf )