use inc::Module::Install 0.64;
-use 5.008001;
+use 5.008001;
perl_version '5.8.1';
name 'Catalyst-Runtime';
all_from 'lib/Catalyst/Runtime.pm';
-#from Moose port:
-requires 'Moose'; #version tbd.
-requires 'MooseX::ClassAttribute'; #version tbd
-
requires 'perl' => '5.8.1';
requires 'Carp';
requires 'Class::Accessor::Fast';
build_requires 'Test::Pod' => 1.14;
build_requires 'Test::Pod::Coverage' => 1.04;
- if ($^O eq 'darwin') {
+ if ($^O eq 'darwin') {
my $osx_ver = `/usr/bin/sw_vers -productVersion`;
chomp $osx_ver;
makemaker_args(dist => { PREOP => qq{\@if [ "\$\$$attr" != "true" ]; then}.
qq{ echo "You must set the ENV variable $attr to true,"; }.
- ' echo "to avoid getting resource forks in your dist."; exit 255; fi' });
+ ' echo "to avoid getting resource forks in your dist."; exit 255; fi' });
}
}
perl -MCPANPLUS -e 'install Catalyst::Devel' # or
perl -MCPAN -e 'install Catalyst::Devel'
- To get some commonly used plugins, as well as the TT view and DBIC
+ To get some commonly used plugins, as well as the TT view and DBIC
model, install Task::Catalyst in the same way.
Have fun!
* Catalyst::Action
* Catalyst::ActionChain
* Catalyst::ActionContainer
- * Catalyst::Log
- * Catalyst::Exception
- Make classes immutable at setup() time
package Catalyst;
-use Moose;
-#use MooseX::ClassAttribute;
-extends 'Catalyst::Component';
-
+use strict;
+use base 'Catalyst::Component';
use bytes;
use Catalyst::Exception;
use Catalyst::Log;
BEGIN { require 5.008001; }
-has counter => ( is => 'rw');
-has request => ( is => 'rw');
-has response => ( is => 'rw');
-has state => ( is => 'rw');
-has action => ( is => 'rw');
-has stack => ( is => 'rw');
-has namespace => ( is => 'rw');
-has stats => ( is => 'rw');
-
+__PACKAGE__->mk_accessors(
+ qw/counter request response state action stack namespace stats/
+);
attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
our $RECURSION = 1000;
our $DETACH = "catalyst_detach\n";
-# class_has components => (is => 'rw');
-# class_has arguments => (is => 'rw');
-# class_has dispatcher => (is => 'rw');
-# class_has engine => (is => 'rw');
-# class_has log => (is => 'rw');
-# class_has dispatcher_class => (is => 'rw', required => 1, default => sub {'Catalyst::Dispatcher'});
-# class_has engine_class => (is => 'rw', required => 1, default => sub {'Catalyst::Engine::CGI'});
-# class_has context_class => (is => 'rw');
-# class_has request_class => (is => 'rw', required => 1, default => sub {'Catalyst::Request'});
-# class_has response_class => (is => 'rw', required => 1, default => sub {'Catalyst::Response'});
-# class_has stats_class => (is => 'rw', required => 1, default => sub {'Catalyst::Stats'});
-# class_has setup_finished => (is => 'rw');
-
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
- engine_class context_class request_class response_class stats_class
+ engine_class context_class request_class response_class stats_class
setup_finished/;
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
unless ( $caller->isa('Catalyst') ) {
no strict 'refs';
push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
- #my $caller_meta = $caller->meta;
- #my @isa = $caller_meta->superclasses;
- #$caller_meta->superclasses(@isa, $class, 'Catalyst::Controller');
}
$caller->arguments( [@arguments] );
### in lib/MyApp.pm
use Catalyst qw/-Debug/; # include plugins here as well
-
+
### In lib/MyApp/Controller/Root.pm (autocreated)
sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
$c->stash->{template} = 'foo.tt'; # set the template
# lookup something from db -- stash vars are passed to TT
- $c->stash->{data} =
+ $c->stash->{data} =
$c->model('Database::Foo')->search( { country => $args[0] } );
if ( $c->req->params->{bar} ) { # access GET or POST parameters
$c->forward( 'bar' ); # process another action
- # do something else after forward returns
+ # do something else after forward returns
}
}
-
+
# The foo.tt TT template can use the stash data from the database
[% WHILE (item = data.next) %]
[% item.foo %]
[% END %]
-
+
# called for /bar/of/soap, /bar/of/soap/10, etc.
sub bar : Path('/bar/of/soap') { ... }
# called for all actions, from the top-most controller downwards
- sub auto : Private {
+ sub auto : Private {
my ( $self, $c ) = @_;
if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
$c->res->redirect( '/login' ); # require login
}
return 1; # success; carry on to next action
}
-
+
# called after all actions are finished
- sub end : Private {
+ sub end : Private {
my ( $self, $c ) = @_;
if ( scalar @{ $c->error } ) { ... } # handle errors
return if $c->res->body; # already have a response
### in MyApp/Controller/Foo.pm
# called for /foo/bar
sub bar : Local { ... }
-
+
# called for /blargle
sub blargle : Global { ... }
-
+
# an index action matches /foo, but not /foo/1, etc.
sub index : Private { ... }
-
+
### in MyApp/Controller/Foo/Bar.pm
# called for /foo/bar/baz
sub baz : Local { ... }
-
+
# first Root auto is called, then Foo auto, then this
sub auto : Private { ... }
-
+
# powerful regular expression paths are also possible
sub details : Regex('^product/(\w+)/details$') {
my ( $self, $c ) = @_;
environment settings override the application, with <MYAPP>_STATS having the
highest priority.
-e.g.
+e.g.
use Catalyst qw/-Stats=1/
=head2 $c->detach()
-The same as C<forward>, but doesn't return to the previous action when
-processing is finished.
+The same as C<forward>, but doesn't return to the previous action when
+processing is finished.
When called with no arguments it escapes the processing chain entirely.
$c->stash->{foo} = $bar;
$c->stash( { moose => 'majestic', qux => 0 } );
$c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
-
+
# stash is automatically passed to the view for use in a template
$c->forward( 'MyApp::View::TT' );
return $comp;
}
-# Find possible names for a prefix
+# Find possible names for a prefix
sub _comp_names {
my ( $c, @prefixes ) = @_;
Any extra arguments are directly passed to ACCEPT_CONTEXT.
-If the name is omitted, it will look for
+If the name is omitted, it will look for
- a model object in $c->stash{current_model_instance}, then
- a model name in $c->stash->{current_model}, then
- a config setting 'default_model', or
@args )
if $name;
if (ref $c) {
- return $c->stash->{current_model_instance}
+ return $c->stash->{current_model_instance}
if $c->stash->{current_model_instance};
return $c->model( $c->stash->{current_model} )
if $c->stash->{current_model};
Any extra arguments are directly passed to ACCEPT_CONTEXT.
-If the name is omitted, it will look for
+If the name is omitted, it will look for
- a view object in $c->stash{current_view_instance}, then
- a view name in $c->stash->{current_view}, then
- a config setting 'default_view', or
@args )
if $name;
if (ref $c) {
- return $c->stash->{current_view_instance}
+ return $c->stash->{current_view_instance}
if $c->stash->{current_view_instance};
return $c->view( $c->stash->{current_view} )
if $c->stash->{current_view};
=cut
-around config => sub {
- my $orig = shift;
+sub config {
my $c = shift;
$c->log->warn("Setting config after setup has been run is not a good idea.")
if ( @_ and $c->setup_finished );
- $c->$orig(@_);
-};
+ $c->NEXT::config(@_);
+}
=head2 $c->log
$class->_register_plugin( $plugin, 1 );
eval { $plugin->import };
- #MooseX::ClassAttribute::process_class_attribute($class, $name => (is => 'rw'));
$class->mk_classdata($name);
my $obj;
eval { $obj = $plugin->new(@args) };
EOF
}
-
+
if ( $class->debug ) {
my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
}
unshift(@args, $namespace || '');
}
-
+
# join args with '/', or a blank string
my $args = join('/', grep { defined($_) } @args);
$args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
</li>
</ul>
<h2>In conclusion</h2>
- <p>The Catalyst team hopes you will enjoy using Catalyst as much
+ <p>The Catalyst team hopes you will enjoy using Catalyst as much
as we enjoyed making it. Please contact us if you have ideas
for improvement or other feedback.</p>
</div>
sub dump_these {
my $c = shift;
- [ Request => $c->req ],
- [ Response => $c->res ],
+ [ Request => $c->req ],
+ [ Response => $c->res ],
[ Stash => $c->stash ],
[ Config => $c->config ];
}
my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
push( @{ $c->stack }, $code );
-
+
eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
$c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
-
+
my $last = pop( @{ $c->stack } );
if ( my $error = $@ ) {
# forward, locate the caller
if ( my $parent = $c->stack->[-1] ) {
$c->stats->profile(
- begin => $action,
+ begin => $action,
parent => "$parent" . $c->counter->{"$parent"},
uid => $uid,
);
}
}
else {
-
+
# root-level call
$c->stats->profile(
begin => $action,
my $request = delete $localized->{request} || {};
my $response = delete $localized->{response} || {};
-
+
local @{ $c }{ keys %$localized } = values %$localized;
local @{ $c->request }{ keys %$request } = values %$request;
local @{ $c->response }{ keys %$response } = values %$response;
$c->finalize_body;
}
-
- if ($c->use_stats) {
+
+ if ($c->use_stats) {
my $elapsed = sprintf '%f', $c->stats->elapsed;
my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
$c->log->info(
- "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
+ "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
}
return $c->response->status;
if ( my $location = $c->response->redirect ) {
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
$c->response->header( Location => $location );
-
+
if ( !$c->response->body ) {
# Add a default body if none is already present
$c->response->body(
my $c = $class->prepare(@arguments);
$c->dispatch;
- $status = $c->finalize;
+ $status = $c->finalize;
};
if ( my $error = $@ ) {
$c->stats($class->stats_class->new)->enable($c->use_stats);
if ( $c->debug ) {
- $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
+ $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
}
# For on-demand data
# Prepare the body for reading, either by prepare_body
# or the user, if they are using $c->read
$c->prepare_read;
-
+
# Parse the body unless the user wants it on-demand
unless ( $c->config->{parse_on_demand} ) {
$c->prepare_body;
my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
my $config = $class->config->{ setup_components };
my $extra = delete $config->{ search_extra } || [];
-
+
push @paths, @$extra;
-
+
my $locator = Module::Pluggable::Object->new(
search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
%$config
my @comps = sort { length $a <=> length $b } $locator->plugins;
my %comps = map { $_ => 1 } @comps;
-
+
for my $component ( @comps ) {
# We pass ignore_loaded here so that overlay files for (e.g.)
$component => $module,
map {
$_ => $class->setup_component( $_ )
- } grep {
+ } grep {
not exists $comps{$_}
} Devel::InnerPackage::list_packages( $component )
);
-
+
for my $key ( keys %modules ) {
$class->components->{ $key } = $modules{ $key };
}
}
-=head2 $c->registered_plugins
+=head2 $c->registered_plugins
Returns a sorted list of the plugins which have either been stated in the
import list or which have been added via C<< MyApp->plugin(@args); >>.
unless ($instant) {
no strict 'refs';
unshift @{"$class\::ISA"}, $plugin;
- # $class->meta->superclasses($plugin, $class->meta->superclasses);
}
return $class;
}
parsing with a config parameter.
MyApp->config->{parse_on_demand} = 1;
-
+
=head1 PROXY SUPPORT
Many production servers operate using the common double-server approach,
the frontend and backend servers on the same machine. The following
changes are made to the request.
- $c->req->address is set to the user's real IP address, as read from
+ $c->req->address is set to the user's real IP address, as read from
the HTTP X-Forwarded-For header.
-
+
The host value for $c->req->base and $c->req->uri is set to the real
host, as read from the HTTP X-Forwarded-Host header.
headers.
MyApp->config->{using_frontend_proxy} = 1;
-
+
If you do not wish to use the proxy support at all, you may set:
MyApp->config->{ignore_frontend_proxy} = 1;
package Catalyst::AttrContainer;
-use Moose;
-#use MooseX::ClassAttribute;
+use strict;
+use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
+
use Catalyst::Exception;
-use Class::Data::Inheritable;
-{
- my $mk_classdata = Class::Data::Inheritable->can('mk_classdata');
- __PACKAGE__->meta->add_method(mk_classdata => $mk_classdata);
-}
+use NEXT;
-__PACKAGE__->mk_classdata(_attr_cache => {});
-__PACKAGE__->mk_classdata(_action_cache => []);
-
-# class_has _attr_cache => (
-# is => 'rw',
-# isa => 'HashRef',
-# required => 1,
-# default => sub{{}}
-# );
-# class_has _action_cache => (
-# is => 'rw',
-# isa => 'ArrayRef',
-# required => 1,
-# default => sub{ [] }
-# );
+__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
+__PACKAGE__->_attr_cache( {} );
+__PACKAGE__->_action_cache( [] );
# note - see attributes(3pm)
sub MODIFY_CODE_ATTRIBUTES {
my ( $class, $code, @attrs ) = @_;
- #can't the below just be $class->_attr_cache->{$code} = \@attrs; ?
$class->_attr_cache( { %{ $class->_attr_cache }, $code => [@attrs] } );
- #why can't this just be push @{$class->_action_cache}, [$code, \@attrs] ?
$class->_action_cache(
[ @{ $class->_action_cache }, [ $code, [@attrs] ] ] );
return ();
=head1 DESCRIPTION
-This class sets up the code attribute cache. It's a base class for
+This class sets up the code attribute cache. It's a base class for
L<Catalyst::Controller>.
=head1 METHODS
package Catalyst::Component;
-use Moose;
-#use MooseX::ClassAttribute;
-use Catalyst::Utils;
-use Class::Data::Inheritable;
+use strict;
+use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
use NEXT;
-
-{
- my $mk_classdata = Class::Data::Inheritable->can('mk_classdata');
- __PACKAGE__->meta->add_method(mk_classdata => $mk_classdata);
-}
-
-__PACKAGE__->mk_classdata(_config => {});
-__PACKAGE__->mk_classdata('_plugins');
-
-# class_has _config => (
-# is => 'rw',
-# isa => 'HashRef',
-# required => 1,
-# default => sub { {} }
-# );
-
-# class_has _plugins => ( is => 'rw' );
+use Catalyst::Utils;
=head1 NAME
my ( $self, $c ) = @_;
$c->response->output( $self->{foo} );
}
-
+
1;
# Methods can be a request step
=head1 DESCRIPTION
-This is the universal base class for Catalyst components
+This is the universal base class for Catalyst components
(Model/View/Controller).
It provides you with a generic new() for instantiation through Catalyst's
=cut
-#to do: are we switching to moose-style key => value constructors from
-# catalyst-style {key => value} constructors ?
+__PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
+
-around new => sub {
- my $orig = shift;
+
+sub new {
my ( $self, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
- my $merged = $self->merge_config_hashes( $self->config, $arguments );
- $orig->( $self, $merged );
-};
+
+ return $self->NEXT::new(
+ $self->merge_config_hashes( $self->config, $arguments ) );
+}
sub COMPONENT {
my ( $self, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
- #Moose TODO: I don't think I fully grok NEXT. is this here for MI or something?
- # how can we have a next here? this -is- the base class....
if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
return $new;
}
- #new here will always pass because $self ISA Moose::Object
else {
if ( my $new = $self->new( $c, $arguments ) ) {
return $new;
}
else {
my $class = ref $self || $self;
- my $new = $self->merge_config_hashes(
+ my $new = $self->merge_config_hashes(
$self->config, $arguments );
- #this will break, Moose::Object::new won't act like this
return bless $new, $class;
}
}
}
-#Moose TODO: I have no fucking clue what's going on here (groditi)
sub config {
my $self = shift;
my $config_sub = $self->can('_config');
- my $config = $self->$config_sub();
- #my $config = $self->_config;
+ my $config = $self->$config_sub() || {};
if (@_) {
my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
$self->_config(
if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
- #this is retarded. if we want a new ref we could do: { %$config }
$config = $self->merge_config_hashes( $config, {} );
$self->$config_sub_now( $config );
}
it is called by Catalyst during setup_components with the application class
as $c and any config entry on the application for this component (for example,
in the case of MyApp::Controller::Foo this would be
-MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
-hashref and are merged with the __PACKAGE__->config hashref before calling
+MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
+hashref and are merged with the __PACKAGE__->config hashref before calling
->new to instantiate the component.
=head2 $c->config
=head2 $c->config($key, $value, ...)
-Accessor for this component's config hash. Config values can be set as
+Accessor for this component's config hash. Config values can be set as
key value pair, or you can specify a hashref. In either case the keys
-will be merged with any existing config settings. Each component in
+will be merged with any existing config settings. Each component in
a Catalyst application has it's own config hash.
=head2 $c->process()
This is the default method called on a Catalyst component in the dispatcher.
-For instance, Views implement this action to render the response body
+For instance, Views implement this action to render the response body
when you forward to them. The default is an abstract method.
=head2 $c->merge_config_hashes( $hashref, $hashref )
package Catalyst::Controller;
-use Moose;
-use Class::MOP ();
-#use MooseX::ClassAttribute;
+use strict;
+use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/;
+
use Catalyst::Exception;
use Catalyst::Utils;
use Class::Inspector;
use NEXT;
-#extends qw/Catalyst::Component Catalyst::AttrContainer/;
-use base qw/Catalyst::Component Catalyst::AttrContainer/;
-
-# class_has _dispatch_steps =>
-# (
-# is => 'rw',
-# isa => 'ArrayRef',
-# required => 1,
-# default => sub{ [qw/_BEGIN _AUTO _ACTION/] },
-# );
-
-# class_has _action_class =>
-# (
-# is => 'rw',
-# isa => 'ClassName',
-# required => 1,
-# default => sub{ 'Catalyst::Action' },
-# );
-
-__PACKAGE__->mk_classdata('_dispatch_steps');
-__PACKAGE__->mk_classdata('_action_class');
-
-__PACKAGE__->_action_class('Catalyst::Action');
-__PACKAGE__->_dispatch_steps([qw/_BEGIN _AUTO _ACTION/]);
-
-
-has _application => ( is => 'rw' );
-### _app as alias
-*_app = *_application;
-
=head1 NAME
Catalyst::Controller - Catalyst Controller base class
package MyApp::Controller::Search
use base qw/Catalyst::Controller/;
- sub foo : Local {
+ sub foo : Local {
my ($self,$c,@args) = @_;
- ...
+ ...
} # Dispatches to /search/foo
=head1 DESCRIPTION
=cut
-# just emulating old behavior. we could probably do this
-# via BUILD later or pass $app as application => $app
-around new => sub {
- my $orig = shift;
- my $self = shift;
- my $app = $_[0];
- my $new = $self->$orig(@_);
- $new->_application( $app );
- return $new;
-};
+__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
+__PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
+__PACKAGE__->_action_class('Catalyst::Action');
+
+__PACKAGE__->mk_accessors( qw/_application/ );
+
+### _app as alias
+*_app = *_application;
sub _DISPATCH : Private {
my ( $self, $c ) = @_;
return !@{ $c->error };
}
+sub new {
+ my $self = shift;
+ my $app = $_[0];
+ my $new = $self->NEXT::new(@_);
+ $new->_application( $app );
+ return $new;
+}
+
+
sub action_for {
my ( $self, $name ) = @_;
my $app = ($self->isa('Catalyst') ? $self : $self->_application);
my $class = ref $self || $self;
my $namespace = $self->action_namespace($c);
my %methods;
- {
- my $meth_map = $class->meta->get_method_map;
- @methods{values %$meth_map} = (keys %$meth_map);
- }
+ $methods{ $self->can($_) } = $_
+ for @{ Class::Inspector->methods($class) || [] };
- #Moose TODO: something tells me that roles could kill the directly code below
# Advanced inheritance support for plugins and the like
my @action_cache;
{
? $args{attributes}{ActionClass}[0]
: $self->_action_class);
- #can we replace with a single call to Class::MOP::load_class() ?
- #unless ( Class::Inspector->loaded($class) ) {
- # require Class::Inspector->filename($class);
- #}
- Class::MOP::load_class($class);
-
+ unless ( Class::Inspector->loaded($class) ) {
+ require Class::Inspector->filename($class);
+ }
+
return $class->new( \%args );
}
will be bound to 'foo/bar'. The default Root controller is an example
of setting namespace to '' (the null string).
-=head2 path
+=head2 path
Sets 'path_prefix', as described below.
package Catalyst::DispatchType;
use Moose;
+#use strict;
+#use base 'Class::Accessor::Fast';
=head1 NAME
package Catalyst::DispatchType::Chained;
use Moose;
+extends 'Catalyst::DispatchType';
+
+#use strict;
+#use base qw/Catalyst::DispatchType/;
use Text::SimpleTable;
use Catalyst::ActionChain;
use URI;
-extends 'Catalyst::DispatchType';
-
-has _endpoints => (
- isa => 'rw',
- isa => 'ArrayRef',
- required => 1,
- default => sub{ [] },
- );
-
-has _actions => (
- isa => 'rw',
- isa => 'HashRef',
- required => 1,
- default => sub{ {} },
- );
-
-has _children_of => (
- isa => 'rw',
- isa => 'HashRef',
- required => 1,
- default => sub{ {} },
- );
-
# please don't perltidy this. hairy code within.
=head1 NAME
sub list {
my ( $self, $c ) = @_;
- return unless $self->_endpoints;
+ return unless $self->{endpoints};
my $paths = Text::SimpleTable->new(
[ 35, 'Path Spec' ], [ 36, 'Private' ]
ENDPOINT: foreach my $endpoint (
sort { $a->reverse cmp $b->reverse }
- @{ $self->_endpoints }
+ @{ $self->{endpoints} }
) {
my $args = $endpoint->attributes->{Args}->[0];
my @parts = (defined($args) ? (("*") x $args) : '...');
if (defined $pp->[0] && length $pp->[0]);
}
$parent = $curr->attributes->{Chained}->[0];
- $curr = $self->_actions->{$parent};
+ $curr = $self->{actions}{$parent};
unshift(@parents, $curr) if $curr;
}
next ENDPOINT unless $parent eq '/'; # skip dangling action
sub recurse_match {
my ( $self, $c, $parent, $path_parts ) = @_;
- my $children = $self->_children_of->{$parent};
+ my $children = $self->{children_of}{$parent};
return () unless $children;
my $best_action;
my @captures;
$action->attributes->{Chained} = [ $parent ];
- my $children = $self->_children_of->{$parent};
+ my $children = ($self->{children_of}{$parent} ||= {});
my @path_part = @{ $action->attributes->{PathPart} || [] };
unshift(@{ $children->{$part} ||= [] }, $action);
- $self->_actions->{'/'.$action->reverse} = $action;
+ ($self->{actions} ||= {})->{'/'.$action->reverse} = $action;
unless ($action->attributes->{CaptureArgs}) {
- unshift(@{ $self->_endpoints }, $action);
+ unshift(@{ $self->{endpoints} ||= [] }, $action);
}
return 1;
if (defined($pp->[0]) && length($pp->[0]));
}
$parent = $curr->attributes->{Chained}->[0];
- $curr = $self->_actions->{$parent};
+ $curr = $self->{actions}{$parent};
}
return undef unless $parent eq '/'; # fail for dangling action
use Moose;
extends 'Catalyst::DispatchType';
+
+#use strict;
+#use base qw/Catalyst::DispatchType/;
+
=head1 NAME
Catalyst::DispatchType::Default - Default DispatchType
use Moose;
extends 'Catalyst::DispatchType';
+#use strict;
+#use base qw/Catalyst::DispatchType/;
+
=head1 NAME
Catalyst::DispatchType::Index - Index DispatchType
package Catalyst::DispatchType::Path;
use Moose;
-use Text::SimpleTable;
-use URI;
-
extends 'Catalyst::DispatchType';
-has _paths => (
- is => 'rw',
- isa => 'HashRef',
- required => 1,
- default => sub {{}}
- );
+#use strict;
+#use base qw/Catalyst::DispatchType/;
+use Text::SimpleTable;
+use URI;
=head1 NAME
sub list {
my ( $self, $c ) = @_;
- my %paths = %{ $self->_paths };
- my @keys = sort keys %paths;
- return unless @keys;
- my $paths_table = Text::SimpleTable->new( [ 35, 'Path' ], [ 36, 'Private' ] );
- foreach my $path ( @keys ) {
+ my $paths = Text::SimpleTable->new( [ 35, 'Path' ], [ 36, 'Private' ] );
+ foreach my $path ( sort keys %{ $self->{paths} } ) {
my $display_path = $path eq '/' ? $path : "/$path";
- foreach my $action ( @{ $paths{$path} } ) {
- $paths_table->row( $display_path, "/$action" );
+ foreach my $action ( @{ $self->{paths}->{$path} } ) {
+ $paths->row( $display_path, "/$action" );
}
}
- $c->log->debug( "Loaded Path actions:\n" . $paths_table->draw . "\n" );
+ $c->log->debug( "Loaded Path actions:\n" . $paths->draw . "\n" )
+ if ( keys %{ $self->{paths} } );
}
=head2 $self->match( $c, $path )
$path ||= '/';
- foreach my $action ( @{ $self->_paths->{$path} || [] } ) {
+ foreach my $action ( @{ $self->{paths}->{$path} || [] } ) {
next unless $action->match($c);
$c->req->action($path);
$c->req->match($path);
$path = '/' unless length $path;
$path = URI->new($path)->canonical;
- unshift( @{ $self->_paths->{$path} ||= [] }, $action);
+ unshift( @{ $self->{paths}{$path} ||= [] }, $action);
return 1;
}
use Moose;
extends 'Catalyst::DispatchType::Path';
+
+#use strict;
+#use base qw/Catalyst::DispatchType::Path/;
use Text::SimpleTable;
use Text::Balanced ();
-has _compiled => (is => 'rw', isa => 'ArrayRef', required => 1, default => sub{[]});
+has _compiled => (
+ is => 'rw',
+ isa => 'ArrayRef',
+ required => 1,
+ default => sub{ [] },
+ );
=head1 NAME
sub list {
my ( $self, $c ) = @_;
- my @regexes = @{ $self->_compiled };
- return unless @regexes;
my $re = Text::SimpleTable->new( [ 35, 'Regex' ], [ 36, 'Private' ] );
- for my $regex ( @regexes ) {
+ for my $regex ( @{ $self->_compiled } ) {
my $action = $regex->{action};
$re->row( $regex->{path}, "/$action" );
}
- $c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" );
+ $c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" )
+ if ( @{ $self->_compiled } );
}
=head2 $self->match( $c, $path )
=cut
-override match => sub {
+sub match {
my ( $self, $c, $path ) = @_;
- return if super();
+ return if $self->SUPER::match( $c, $path );
# Check path against plain text first
}
return 0;
-};
+}
=head2 $self->register( $c, $action )
package Catalyst::Dispatcher;
use Moose;
-use Class::MOP ();
use Catalyst::Exception;
use Catalyst::Utils;
=head1 METHODS
-=head2 new
+=head2 new
Construct a new dispatcher.
sub BUILD {
my ($self, $params) = @_;
- my $container =
+ my $container =
Catalyst::ActionContainer->new( { part => '/', actions => {} } );
$self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
}
my @args;
-
+
if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
@args = @{ pop @extra_params }
} else {
return $self->_action_hash->{"$namespace/$name"};
}
-=head2 $self->get_action_by_path( $path );
-
-Returns the named action by its full path.
+=head2 $self->get_action_by_path( $path );
+
+Returns the named action by its full path.
-=cut
+=cut
sub get_action_by_path {
my ( $self, $path ) = @_;
next if $key eq 'Private';
my $class = "Catalyst::DispatchType::$key";
unless ( $registered->{$class} ) {
- eval { Class::MOP::load_class($class) };
+ eval "require $class";
push( @{ $self->_dispatch_types }, $class->new ) unless $@;
$registered->{$class} = 1;
}
for my $type (@types) {
my $class =
( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
- eval { Class::MOP::load_class($class) };
+ eval "require $class";
Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
if $@;
push @{ $self->_dispatch_types }, $class->new;
package Catalyst::Exception;
-# XXX: See bottom of file for Exception implementation
+use strict;
+use vars qw[@ISA $CATALYST_EXCEPTION_CLASS];
+
+BEGIN {
+ push( @ISA, $CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base' );
+}
package Catalyst::Exception::Base;
-use Moose;
+use strict;
use Carp ();
=head1 NAME
Carp::croak($message);
}
-=head2 meta
-
-Provided by Moose
-
=head1 AUTHOR
Sebastian Riedel, C<sri@cpan.org>
=cut
-package Catalyst::Exception;
-
-use Moose;
-use vars qw[$CATALYST_EXCEPTION_CLASS];
-
-BEGIN {
- extends($CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base');
-}
-
1;
package Catalyst::Log;
use strict;
-#use base 'Class::Accessor::Fast';
+use base 'Class::Accessor::Fast';
use Data::Dump;
our %LEVELS = ();
-use Moose;
-
-has level => (is => 'rw');
-has _body => (is => 'rw');
-has abort => (is => 'rw');
-
-#__PACKAGE__->mk_accessors('level');
-#__PACKAGE__->mk_accessors('body');
-#__PACKAGE__->mk_accessors('abort');
+__PACKAGE__->mk_accessors('level');
+__PACKAGE__->mk_accessors('body');
+__PACKAGE__->mk_accessors('abort');
{
my @levels = qw[ debug info warn error fatal ];
*{$name} = sub {
my $self = shift;
- if ( $self->level & $level ) {
+ if ( $self->{level} & $level ) {
$self->_log( $name, @_ );
}
};
*{"is_$name"} = sub {
my $self = shift;
- return $self->level & $level;
+ return $self->{level} & $level;
};
}
}
sub enable {
my ( $self, @levels ) = @_;
- my $level = $self->level;
- for(map { $LEVELS{$_} } @levels){
- $level |= $_;
- }
- $self->level($level);
+ $self->{level} |= $_ for map { $LEVELS{$_} } @levels;
}
sub disable {
my ( $self, @levels ) = @_;
- my $level = $self->level;
- for(map { $LEVELS{$_} } @levels){
- $level &= ~$_;
- }
- $self->level($level);
+ $self->{level} &= ~$_ for map { $LEVELS{$_} } @levels;
}
sub _dump {
my $level = shift;
my $message = join( "\n", @_ );
$message .= "\n" unless $message =~ /\n$/;
- my $body = $self->_body;
- $body .= sprintf( "[%s] %s", $level, $message );
- $self->_body($body);
+ $self->{body} .= sprintf( "[%s] %s", $level, $message );
}
sub _flush {
my $self = shift;
- if ( $self->abort || !$self->_body ) {
+ if ( $self->abort || !$self->body ) {
$self->abort(undef);
}
else {
- $self->_send_to_log( $self->_body );
+ $self->_send_to_log( $self->body );
}
- $self->_body(undef);
+ $self->body(undef);
}
sub _send_to_log {
$log = Catalyst::Log->new;
$log = Catalyst::Log->new( 'warn', 'error' );
-=head2 level
-
-Contains a bitmask of the currently set log levels.
-
=head2 levels
Set log levels
You may subclass this module and override this method to get finer control
over the log output.
-=head2 meta
-
=head1 SEE ALSO
L<Catalyst>.
package Catalyst::Model;
-use Moose;
-extends 'Catalyst::Component';
+use strict;
+use base qw/Catalyst::Component/;
=head1 NAME
package Catalyst::View;
-use Moose;
-extends 'Catalyst::Component';
+use strict;
+use base qw/Catalyst::Component/;
=head1 NAME
=head1 DESCRIPTION
-This is the Catalyst View base class. It's meant to be used as
+This is the Catalyst View base class. It's meant to be used as
a base class by Catalyst views.
-As a convention, views are expected to read template names from
+As a convention, views are expected to read template names from
$c->stash->{template}, and put the output into $c->res->body.
Some views default to render a template named after the dispatched
action's private name. (See L<Catalyst::Action>.)
-=head1 METHODS
+=head1 METHODS
Implements the same methods as other Catalyst components, see
L<Catalyst::Component>
projects / catagits/Catalyst-Runtime.git / commitdiff