[Jifty-commit] r477 - jifty/trunk/t
jifty-commit at lists.jifty.org
jifty-commit at lists.jifty.org
Fri Jan 6 17:47:50 EST 2006
Author: jesse
Date: Fri Jan 6 17:47:49 2006
New Revision: 477
Modified:
/ (props changed)
jifty/trunk/lib/Jifty/Dispatcher.pm
jifty/trunk/t/04-dispatcher.t
Log:
r22198 at truegrounds: jesse | 2006-01-06 23:46:08 +0100
* The first version of the dispatcher that I think is basically feature complete
* The next step is to entirely replace the mason->jifty->mason call chain with a jifty->mason call chain.
Modified: jifty/trunk/lib/Jifty/Dispatcher.pm
==============================================================================
--- jifty/trunk/lib/Jifty/Dispatcher.pm (original)
+++ jifty/trunk/lib/Jifty/Dispatcher.pm Fri Jan 6 17:47:49 2006
@@ -3,6 +3,7 @@
use warnings;
use Exporter;
use base 'Exporter';
+
=head1 NAME
@@ -10,7 +11,7 @@
=head1 SYNOPSIS
-In your F<autohandler>, change the C<< $m->call_next >> statement to:
+In your F<autohandler>, put these two lines first:
require MyApp::Dispatcher;
MyApp::Dispatcher->handle_request;
@@ -129,7 +130,22 @@
can also pass in an array reference of matches, or a regex pattern.
The C<$match> string may be qualified with a HTTP method name, such as
-C<GET>, C<POST> and C<PUT>.
+
+=over
+
+=item GET
+
+=item POST
+
+=item PUT
+
+=item OPTIONS
+
+=item DELETE
+
+=item HEAD
+
+=back
=head2 on $match => $rule
@@ -183,6 +199,10 @@
Break out from the current C<run> block and go on the next rule.
+=head2 last_rule
+
+Break out from the current C<run> block and stop running rules in this stage.
+
=head2 abort $code
Abort the request.
@@ -209,29 +229,43 @@
our $Dispatcher;
-sub ret (@);
-sub under ($$@) { ret @_ } # partial match at beginning of path component
-sub before ($$@) { ret @_ } # exact match on the path component
-sub on ($$@) { ret @_ } # exact match on the path component
-sub after ($$@) { ret @_ } # exact match on the path component
-sub when (&@) { ret @_ } # exact match on the path component
-sub run (&@) { ret @_ } # execute a block of code
-sub show (;$@) { ret @_ } # render a page
-sub dispatch ($@) { ret @_ } # run dispatch again with another URI
-sub redirect ($@) { ret @_ } # web redirect
-sub abort (;$@) { ret @_ } # abort request
-sub default ($$@) { ret @_ } # set parameter if it's not yet set
-sub set ($$@) { ret @_ } # set parameter
-sub del ($@) { ret @_ } # remove parameter
+sub _ret (@);
+sub under ($$@) { _ret @_ } # partial match at beginning of path component
+sub before ($$@) { _ret @_ } # exact match on the path component
+sub on ($$@) { _ret @_ } # exact match on the path component
+sub after ($$@) { _ret @_ } # exact match on the path component
+sub when (&@) { _ret @_ } # exact match on the path component
+sub run (&@) { _ret @_ } # execute a block of code
+sub show (;$@) { _ret @_ } # render a page
+sub dispatch ($@) { _ret @_ } # run dispatch again with another URI
+sub redirect ($@) { _ret @_ } # web redirect
+sub abort (;$@) { _ret @_ } # abort request
+sub default ($$@) { _ret @_ } # set parameter if it's not yet set
+sub set ($$@) { _ret @_ } # set parameter
+sub del ($@) { _ret @_ } # remove parameter
sub get ($) { $Dispatcher->{args}{ $_[0] } }
-sub qualify ($@);
-sub GET ($) { qualify method => @_ }
-sub POST ($) { qualify method => @_ }
-sub PUT ($) { qualify method => @_ }
-sub HEAD ($) { qualify method => @_ }
-sub DELETE ($) { qualify method => @_ }
-sub OPTIONS ($) { qualify method => @_ }
+sub _qualify ($@);
+sub GET ($) { _qualify method => @_ }
+sub POST ($) { _qualify method => @_ }
+sub PUT ($) { _qualify method => @_ }
+sub HEAD ($) { _qualify method => @_ }
+sub DELETE ($) { _qualify method => @_ }
+sub OPTIONS ($) { _qualify method => @_ }
+
+=head2 import
+
+Jifty::Dispatcher is an L<Exporter>, that is, part of its role is to
+blast a bunch of symbols into another package. In this case, that other
+package is the dispatcher for your application.
+
+You never call import directly. Just:
+
+ use Jifty::Dispatcher -base;
+
+in C<MyApp::Dispatcher>
+
+=cut
sub import {
my $class = shift;
@@ -239,8 +273,9 @@
my @args = grep { !/^-[Bb]ase/ } @_;
no strict 'refs';
- @{ $pkg . '::RULES' } = ();
-
+ for (qw(RULES RULES_SETUP RULES_CLEANUP)) {
+ @{ $pkg . '::' . $_ } = ();
+ }
if ( @args != @_ ) {
# User said "-base", let's push ourselves into their @ISA.
@@ -252,7 +287,7 @@
###################################################
# Magically figure out the arity based on caller info.
-sub ret (@) {
+sub _ret (@) {
my $pkg = caller(1);
my $sub = ( caller(1) )[3];
my $proto = prototype($sub);
@@ -267,33 +302,70 @@
# We are under an operation -- carry the rule forward
foreach my $rule ( [ $op => splice( @_, 0, length($proto) ) ], @_ ) {
- $Dispatcher->handle_rule($rule);
+ $Dispatcher->_handle_rule($rule);
}
} elsif (wantarray) {
( [ $op => splice( @_, 0, length($proto) ) ], @_ );
} elsif ( defined wantarray ) {
[ [ $op => splice( @_, 0, length($proto) ) ], @_ ];
} else {
+ my $ruleset;
+ if ( $op eq 'before' ) {
+ $ruleset = 'RULES_SETUP';
+ } elsif ( $op eq 'after' ) {
+ $ruleset = 'RULES_CLEANUP';
+ } else {
+ $ruleset = 'RULES_RUN';
+ }
+
no strict 'refs';
- push @{ $pkg . '::RULES' },
+
+ # XXX TODO, need to spec stage here.
+ push @{ $pkg . '::' . $ruleset },
[ $op => splice( @_, 0, length($proto) ) ], @_;
}
}
-sub qualify ($@) {
+sub _qualify ($@) {
my $key = shift;
my $op = ( caller(1) )[3];
$op =~ s/.*:://;
return { $key => $op, '' => $_[0] };
}
+=head2 rules STAGE
+
+Returns an array of all the rules for the stage STAGE.
+
+Valid values for STAGE are
+
+=over
+
+=item SETUP
+
+=item RUN
+
+=item CLEANUP
+
+=back
+
+=cut
+
sub rules {
- my $self = shift;
- my $pkg = ref($self) || $self;
+ my $self = shift;
+ my $stage = shift;
+ my $pkg = ref($self) || $self;
no strict 'refs';
- @{ $pkg . '::RULES' };
+ @{ $pkg . '::RULES_' . $stage };
}
+=head2 new
+
+Creates a new Jifty::Dispatcher object. You probably don't ever want
+to do this. (Jifty.pm does it for you)
+
+=cut
+
sub new {
my $self = shift;
return $self if ref($self);
@@ -307,6 +379,17 @@
);
}
+=head2 handle_request
+
+Actually do what your dispatcher does. For now, the right thing
+to do is to put the following two lines first:
+
+ require MyApp::Dispatcher;
+ MyApp::Dispatcher->handle_request;
+
+
+=cut
+
sub handle_request {
my $self = shift;
@@ -328,7 +411,15 @@
}
}
-sub handle_rules ($) {
+=head2 _handle_rules RULESET
+
+When handed an arrayref or array of rules (RULESET), walks through the
+rules in order, executing as it goes.
+
+
+=cut
+
+sub _handle_rules ($) {
my ( $self, $rules ) = @_;
my @rules;
@@ -337,13 +428,21 @@
eval { @rules = @$rules };
@rules = $rules if $@;
}
-
RULE: foreach my $rule (@rules) {
- $self->handle_rule($rule);
+ $self->_handle_rule($rule);
}
}
-sub handle_rule {
+=head2 _handle_rule RULE
+
+When handed a single rule in the form of a coderef, C<_handle_rule>,
+calls C<_do_run> on that rule and returns the result. When handed a
+rule that turns out to be an array of subrules, recursively calls
+itself and evaluates the subrules in order.
+
+=cut
+
+sub _handle_rule {
my ( $self, $rule ) = @_;
my ( $op, @args );
@@ -363,7 +462,7 @@
if ($sub_rules) {
for my $sub_rule (@$sub_rules) {
- $self->handle_rule($sub_rule);
+ $self->_handle_rule($sub_rule);
}
}
@@ -371,6 +470,7 @@
local $self->{rule} = $op;
my $meth = "_do_$op";
$self->$meth(@args);
+
}
no warnings 'exiting';
@@ -384,10 +484,9 @@
=cut
-
sub _do_under {
my ( $self, $cond, $rules ) = @_;
- if ( my $regex = $self->match($cond) ) {
+ if ( my $regex = $self->_match($cond) ) {
# match again to establish $1 $2 etc in the dynamic scope
$self->{path} =~ $regex;
@@ -396,7 +495,7 @@
local $self->{cwd} = substr( $self->{path}, 0, $+[0] );
chop $self->{cwd} if substr( $self->{cwd}, -1 ) eq '/';
- $self->handle_rules($rules);
+ $self->_handle_rules($rules);
}
}
@@ -409,7 +508,7 @@
sub _do_when {
my ( $self, $code, $rules ) = @_;
if ( $code->() ) {
- $self->handle_rules($rules);
+ $self->_handle_rules($rules);
}
}
@@ -421,11 +520,13 @@
sub _do_before {
my ( $self, $cond, $rules ) = @_;
- if ( my $regex = $self->match($cond) ) {
+ if ( my $regex = $self->_match($cond) ) {
+
# match again to establish $1 $2 etc in the dynamic scope
$self->{path} =~ $regex;
- $self->handle_rules($rules);
+ $self->_handle_rules($rules);
}
+
}
=head2 _do_on
@@ -436,10 +537,11 @@
sub _do_on {
my ( $self, $cond, $rules ) = @_;
- if ( my $regex = $self->match($cond) ) {
+ if ( my $regex = $self->_match($cond) ) {
+
# match again to establish $1 $2 etc in the dynamic scope
$self->{path} =~ $regex;
- $self->handle_rules($rules);
+ $self->_handle_rules($rules);
}
}
@@ -451,16 +553,14 @@
sub _do_after {
my ( $self, $cond, $rules ) = @_;
- if ( my $regex = $self->match($cond) ) {
+ if ( my $regex = $self->_match($cond) ) {
+
# match again to establish $1 $2 etc in the dynamic scope
$self->{path} =~ $regex;
- $self->handle_rules($rules);
+ $self->_handle_rules($rules);
}
}
-
-
-
sub _do_run {
my ( $self, $code ) = @_;
@@ -483,7 +583,8 @@
sub _do_redirect {
my ( $self, $path ) = @_;
- Jifty->web->redirect($path);
+ eval {Jifty->web->redirect($path);};
+ die $@ unless ( UNIVERSAL::isa $@, 'HTML::Mason::Exception::Abort' ) ;
last_rule;
}
@@ -497,7 +598,8 @@
sub _do_abort {
my $self = shift;
- $self->{mason}->abort(@_);
+ eval {Jifty->web->mason->abort(@_)};
+ die $@ unless ( UNIVERSAL::isa $@, 'HTML::Mason::Exception::Abort' ) ;
last_rule;
}
@@ -515,22 +617,17 @@
my $self = shift;
my $path;
$path = shift if (@_);
- my $m = $self->{mason};
eval {
if ( !defined $path )
{
- $m->call_next( %{ $self->{args} } );
+ Jifty->web->mason->call_next( %{ $self->{args} } );
} else {
$path = "$self->{cwd}/$path" unless $path =~ m{^/};
- $m->comp( $path, %{ $self->{args} } );
+ Jifty->web->mason->comp( $path, %{ $self->{args} } );
}
};
- if ( my $err = $@ ) {
- die "Dispatcher couldn't run a mason component"
- . ( $path ? " ($path)" : '' ) . ":\n"
- . $err;
- }
- $self->last_rule;
+ die $@ unless ( UNIVERSAL::isa $@, 'HTML::Mason::Exception::Abort' ) ;
+ last_rule;
}
sub _do_set {
@@ -552,11 +649,15 @@
=head2 _do_dispatch [PATH]
-Actually run the dispatcher.
-
-=cut
+First, this routine runs all the C<before> dispatcher rules, then it runs
+Jifty->web->handle_request(), then it runs all the main C<on> rules,
+evaluating each one in turn. If it gets through all the rules without
+running an C<abort>, C<redirect> or C<show> directive, it C<shows>
+the template originally requested.
+Once it's done with that, it runs all the C<after> "cleanup" rules.
+=cut
sub _do_dispatch {
my $self = shift;
@@ -567,14 +668,32 @@
# Normalize the path.
$self->{path} =~ s{/+}{/}g;
$self->{path} =~ s{/$}{};
-
-HANDLER: {
- $self->handle_rules( [ $self->rules, 'show' ] );
+ eval {
+ HANDLER: {
+ $self->_handle_rules( [ $self->rules('SETUP') ] );
+ eval {Jifty->web->handle_request();};
+ die $@ unless ( UNIVERSAL::isa $@, 'HTML::Mason::Exception::Abort' ) ;
+ $self->_handle_rules( [ $self->rules('RUN'), 'show' ] );
+ $self->_handle_rules( [ $self->rules('CLEANUP') ] );
+ }
+ last_rule;
+ };
+ if ( my $err = $@ ) {
+ warn ref($err) .$err;
}
- last_rule;
}
-sub match {
+=head2 _match CONDITION
+
+Returns the regular expression matched if the current request fits
+the condition defined by CONDITION.
+
+C<CONDITION> can be a regular expression, a "simple string" to match against,
+or an arrayref or hashref of those. It should even be nestable.
+
+=cut
+
+sub _match {
my ( $self, $cond ) = @_;
# Handle the case where $cond is an array.
@@ -583,11 +702,11 @@
my $rv = eval {
for my $sub_cond (@$cond)
{
- return ( $self->match($sub_cond) or next );
+ return ( $self->_match($sub_cond) or next );
}
};
if ( my $err = $@ ) {
- warn "$self match failed: $err";
+ warn "$self _match failed: $err";
} else {
return $rv;
}
@@ -600,15 +719,15 @@
for my $key ( sort keys %$cond )
{
next if $key eq '';
- my $meth = "match_$key";
+ my $meth = "_match_$key";
$self->$meth( $cond->{$key} ) or return;
}
# All precondition passed, get original condition literal
- return $self->match( $cond->{''} );
+ return $self->_match( $cond->{''} );
};
if ( my $err = $@ ) {
- warn "$self match failed: $err";
+ warn "$self _match failed: $err";
} else {
return $rv;
}
@@ -616,18 +735,32 @@
# Now we know $cond is a scalar, match against it.
else {
- my $regex = $self->compile_cond($cond) or return;
+ my $regex = $self->_compile_condition($cond) or return;
$self->{path} =~ $regex or return;
return $regex;
}
}
-sub match_method {
+=head2 _match_method METHOD
+
+Takes an HTTP method. Returns true if the current request
+came in with that method.
+
+=cut
+
+sub _match_method {
my ( $self, $method ) = @_;
lc( $self->{mason}->cgi_request->method ) eq lc($method);
}
-sub compile_cond {
+=head2 _compile_condition CONDITION
+
+Takes a condition defined as a simple string ad return it as a regex
+condition.
+
+=cut
+
+sub _compile_condition {
my ( $self, $cond ) = @_;
# Previously compiled (eg. a qr{} -- return it verbatim)
@@ -662,8 +795,8 @@
}
# Make all metachars into capturing submatches
- unless (
- $cond =~ s{( (?: \\ [*?] )+ )}{'('. $self->_compile_glob($1) .')'}egx )
+ unless ( $cond
+ =~ s{( (?: \\ [*?] )+ )}{'('. $self->_compile_glob($1) .')'}egx )
{
$cond = "($cond)";
}
@@ -680,7 +813,6 @@
=cut
-
sub _compile_glob {
my ( $self, $glob ) = @_;
$glob =~ s{\\}{}g;
@@ -689,4 +821,6 @@
$glob;
}
+
+
1;
Modified: jifty/trunk/t/04-dispatcher.t
==============================================================================
--- jifty/trunk/t/04-dispatcher.t (original)
+++ jifty/trunk/t/04-dispatcher.t Fri Jan 6 17:47:49 2006
@@ -3,7 +3,7 @@
use warnings;
use strict;
-use Test::More qw/no_plan/;
+use Test::More skip_all => 'Not written yet';
use_ok('Jifty::Dispatcher');
use_ok('Jifty');
ok(Jifty->new(no_handle => 1));
More information about the Jifty-commit
mailing list