package Catalyst;
+use Class::C3;
use Moose;
extends 'Catalyst::Component';
use bytes;
has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
has namespace => (is => 'rw');
+no Moose;
attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
sub depth { scalar @{ shift->stack || [] }; }
-
-# Laziness++
-*comp = \&component;
+sub comp { shift->component(@_) }
sub req {
# carp "the use of req() is deprecated in favour of request()";
}
# For backwards compatibility
-*finalize_output = \&finalize_body;
+sub finalize_output { shift->finalize_body(@_) };
# For statistics
our $COUNT = 1;
=cut
-around stash => sub {
- my $orig = shift;
+sub stash {
my $c = shift;
-
- my $orig_stash = $c->$orig();
if (@_) {
my $stash = @_ > 1 ? {@_} : $_[0];
croak('stash takes a hash or hashref') unless ref $stash;
foreach my $key ( keys %$stash ) {
- $orig_stash->{$key} = $stash->{$key};
+ #shouldn't we hold this in a var and save ourselves the subcall?
+ $c->next::method->{$key} = $stash->{$key};
}
}
- return $orig_stash;
-};
+
+ return $c->next::method;
+}
+
=head2 $c->error
=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::method(@_);
+}
=head2 $c->log
=cut
+use Class::C3;
use Moose;
has class => (is => 'rw');
package Catalyst::ActionChain;
+use Class::C3;
use Moose;
extends qw(Catalyst::Action);
has chain => (is => 'rw');
+no Moose;
+
=head1 NAME
Catalyst::ActionChain - Chain of Catalyst Actions
return $self->new({ %$final, chain => $actions });
}
-no Moose;
__PACKAGE__->meta->make_immutable;
1;
=cut
+use Class::C3;
use Moose;
use overload (
has part => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
has actions => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
-around 'new' => sub {
- my $next = shift;
+no Moose;
+
+sub new {
my ($self, $params) = @_;
$params = { part => $params } unless ref $params;
- $next->($self, $params);
-};
+ $self->next::method($params);
+}
-no Moose;
sub get_action {
my ( $self, $name ) = @_;
with 'Catalyst::ClassData';
+no Moose;
+
__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
__PACKAGE__->_attr_cache( {} );
__PACKAGE__->_action_cache( [] );
package Catalyst::Base;
+use Class::C3;
use Moose;
BEGIN{ extends qw/Catalyst::Controller/ };
-
+no Moose;
1;
package Catalyst::Component;
+use Class::C3;
use Moose;
use MooseX::Adopt::Class::Accessor::Fast;
use Catalyst::Utils;
with 'MooseX::Emulate::Class::Accessor::Fast';
with 'Catalyst::ClassData';
+no Moose;
=head1 NAME
__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 $args = $self->merge_config_hashes( $self->config, $arguments );
- return $self->$orig( $args );
-};
+ $self->next::method( $args );
+}
sub COMPONENT {
my ( $self, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
- $self->new($c, $arguments);
-
-# if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
-# return $new;
-# }
-# else {
-# if ( my $new = $self->new( $c, $arguments ) ) {
-# return $new;
-# }
-# else {
-# my $class = ref $self || $self;
-# my $new = $self->merge_config_hashes(
-# $self->config, $arguments );
-# return bless $new, $class;
-# }
-# }
+
+
+ #this is not the EXACT logic we had before, since the original tested
+ #for a true value before returning meaning that a subsequent COMPONENT
+ #call could return undef and that would trigger a try to new, which could
+ #again return undef, which would lead to a straight bless of the args and
+ #config. I did not mantain that behavior because it did not seemed sane
+ # please rip me a new one if you have reason to believe i am being stupid
+ # --groditi
+ return $self->next::can ?
+ $self->next::method($c, $arguments) : $self->new($c, $arguments);
}
sub config {
package Catalyst::Controller;
#switch to BEGIN { extends qw/ ... /; } ?
+use Class::C3;
use base qw/Catalyst::Component Catalyst::AttrContainer/;
use Moose;
# isa => 'ClassName|Catalyst' ?
has _application => (is => 'rw');
-sub _app{ shift->_application(@_) } # eww
+sub _app{ shift->_application(@_) }
sub BUILD {
my ($self, $args) = @_;
return !@{ $c->error };
}
-around new => sub {
- my $orig = shift;
+sub new {
my $self = shift;
my $app = $_[0];
- my $new = $self->$orig(@_);
+ my $new = $self->next::method(@_);
$new->_application( $app );
return $new;
-};
+}
sub action_for {
my ( $self, $name ) = @_;
return $app->dispatcher->get_action($name, $self->action_namespace);
}
+#my opinion is that this whole sub really should be a builder method, not
+#something that happens on every call. Anyone else disagree?? -- groditi
+
+#we are wrapping the accessor, so just uyse a modifier since a normal sub would
+#just be overridden by the generated moose method
around action_namespace => sub {
- my ( $orig, $self, $c ) = @_;
+ my $orig = shift;
+ my ( $self, $c ) = @_;
if( ref($self) ){
return $self->$orig if $self->has_action_namespace;
- } else {
+ } else {
+ # if the following won't change at runtime it should be lazy_building thing
return $self->config->{namespace} if exists $self->config->{namespace};
}
#the following looks like a possible target for a default setting. i am not
#making the below the builder because i don't know if $c will vary from
- #call to call, which would affect case sensitivitysettings -- groditi
+ #call to call, which would affect case sensitivity settings -- groditi
my $case_s;
if( $c ){
$case_s = $c->config->{case_sensitive};
return Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
};
-
+#Once again, this is probably better written as a builder method
around path_prefix => sub {
my $orig = shift;
my $self = shift;
return ( 'ActionClass', $value );
}
+no Moose;
+
1;
__END__
package Catalyst::DispatchType;
-use Moose;
-#use strict;
-#use base 'Class::Accessor::Fast';
+use Class::C3;
+use Moose; # using it to add Moose::Object to @ISA ...
+no Moose;
=head1 NAME
=cut
-no Moose;
__PACKAGE__->meta->make_immutable;
1;
package Catalyst::DispatchType::Chained;
+use Class::C3;
use Moose;
extends 'Catalyst::DispatchType';
default => sub{ {} },
);
+no Moose;
+
# please don't perltidy this. hairy code within.
=head1 NAME
}
-no Moose;
__PACKAGE__->meta->make_immutable;
=head1 USAGE
package Catalyst::DispatchType::Default;
+use Class::C3;
use Moose;
extends 'Catalyst::DispatchType';
-
-#use strict;
-#use base qw/Catalyst::DispatchType/;
+no Moose;
=head1 NAME
=cut
-no Moose;
__PACKAGE__->meta->make_immutable;
1;
package Catalyst::DispatchType::Index;
+use Class::C3;
use Moose;
extends 'Catalyst::DispatchType';
-
-#use strict;
-#use base qw/Catalyst::DispatchType/;
+no Moose;
=head1 NAME
=cut
-no Moose;
__PACKAGE__->meta->make_immutable;
1;
package Catalyst::DispatchType::Path;
+use Class::C3;
use Moose;
extends 'Catalyst::DispatchType';
-#use strict;
-#use base qw/Catalyst::DispatchType/;
use Text::SimpleTable;
use URI;
default => sub { +{} },
);
+no Moose;
+
=head1 NAME
Catalyst::DispatchType::Path - Path DispatchType
=cut
-no Moose;
__PACKAGE__->meta->make_immutable;
1;
package Catalyst::DispatchType::Regex;
+use Class::C3;
use Moose;
extends 'Catalyst::DispatchType::Path';
-#use strict;
-#use base qw/Catalyst::DispatchType::Path/;
use Text::SimpleTable;
use Text::Balanced ();
default => sub{ [] },
);
+no Moose;
+
=head1 NAME
Catalyst::DispatchType::Regex - Regex DispatchType
=cut
-no Moose;
__PACKAGE__->meta->make_immutable;
1;
for my $type (@types) {
my $class =
( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
- #eval "require $class";
+
eval { Class::MOP::load_class($class) };
Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
if $@;
package Catalyst::Engine;
+use Class::C3;
use Moose;
with 'MooseX::Emulate::Class::Accessor::Fast';
has read_length => (is => 'rw');
has read_position => (is => 'rw');
+no Moose;
+
# Stringify to class
use overload '""' => sub { return ref shift }, fallback => 1;
package Catalyst::Engine::CGI;
+use Class::C3;
use Moose;
extends 'Catalyst::Engine';
has env => (is => 'rw');
+no Moose;
+
=head1 NAME
Catalyst::Engine::CGI - The CGI Engine
=cut
-around prepare_query_parameters => sub {
- my $orig = shift;
+sub prepare_query_parameters {
my ( $self, $c ) = @_;
local (*ENV) = $self->env || \%ENV;
if ( $ENV{QUERY_STRING} ) {
- $self->$orig( $c, $ENV{QUERY_STRING} );
+ $self->next::method( $c, $ENV{QUERY_STRING} );
}
-};
+}
=head2 $self->prepare_request($c, (env => \%env))
=cut
-before prepare_write => sub {
+sub prepare_write {
*STDOUT->autoflush(1);
-};
+ return shift->next::method(@_);
+}
=head2 $self->write($c, $buffer)
=cut
-around write => sub {
- my $orig = shift;
+sub write {
my ( $self, $c, $buffer ) = @_;
# Prepend the headers if they have not yet been sent
$buffer = $headers . $buffer;
}
- return $self->$orig( $c, $buffer );
-};
+ return $self->next::method( $c, $buffer );
+}
=head2 $self->read_chunk($c, $buffer, $length)
package Catalyst::Engine::FastCGI;
+use Class::C3;
use Moose;
extends 'Catalyst::Engine::CGI';
+# eval { Class::MOP::load_class("FCGI") };
eval "use FCGI";
die "Unable to load the FCGI module, you may need to install it:\n$@\n" if $@;
package Catalyst::Engine::HTTP;
+use Class::C3;
use Moose;
extends 'Catalyst::Engine::CGI';
+no Moose;
+
use Data::Dump qw(dump);
use Errno 'EWOULDBLOCK';
use HTTP::Date ();
=cut
-before finalize_read => sub {
+sub finalize_read {
# Never ever remove this, it would result in random length output
# streams if STDIN eq STDOUT (like in the HTTP engine)
*STDIN->blocking(1);
-};
+ shift->next::method(@_);
+}
=head2 $self->prepare_read($c)
=cut
-befpre prepare_read => sub {
+sub prepare_read {
# Set the input handle to non-blocking
*STDIN->blocking(0);
-};
+ shift->next::method(@_);
+}
=head2 $self->read_chunk($c, $buffer, $length)
=cut
-around write => sub {
- my $orig = shift;
+sub write {
my ( $self, $c, $buffer ) = @_;
# Avoid 'print() on closed filehandle Remote' warnings when using IE
$buffer = $headers . $buffer;
}
- my $ret = $self->$orig( $c, $buffer );
+ my $ret = $self->next::method($c, $buffer);
if ( !defined $ret ) {
$self->{_write_error} = $!;
else {
DEBUG && warn "write: Wrote response ($ret bytes)\n";
}
-
+
return $ret;
-};
+}
=head2 run
package Catalyst::Engine::HTTP::Restarter;
+use Class::C3;
use Moose;
extends 'Catalyst::Engine::HTTP';
+no Moose;
+
use Catalyst::Engine::HTTP::Restarter::Watcher;
-around run => sub {
- my $orig = shift;
+sub run {
my ( $self, $class, $port, $host, $options ) = @_;
$options ||= {};
}
}
- return $self->$orig( $class, $port, $host, $options );
+ return $self->next::method( $class, $port, $host, $options );
};
1;
has watch_list => (is => 'rw');
has follow_simlinks => (is => 'rw');
-sub new {
- my ( $class, %args ) = @_;
+no Moose;
- my $self = {%args};
-
- bless $self, $class;
-
- $self->_init;
-
- return $self;
+sub BUILD {
+ shift->_init;
}
sub _init {
package Catalyst::Log;
+use Class::C3;
use Moose;
use Data::Dump;
}
}
-around new => sub {
- my $orig = shift;
+sub new {
my $class = shift;
- my $self = $class->$orig;
+ my $self = $class->next::method;
$self->levels( scalar(@_) ? @_ : keys %LEVELS );
return $self;
-};
+}
sub levels {
my ( $self, @levels ) = @_;
extends qw/Catalyst::Component/;
no Moose;
-__PACKAGE__->meta->make_immutable();
+
+#We can't immutablize anything that ISA Component just yet
+#__PACKAGE__->meta->make_immutable();
=head1 NAME
package Catalyst::Request;
+use Class::C3;
use IO::Socket qw[AF_INET inet_aton];
use Carp;
use utf8;
lazy => 1,
);
+#Moose ToDo:
+#can we lose the before modifiers which just call prepare_body ?
+#they are wasteful, slow us down and feel cluttery.
+# Can we call prepare_body at BUILD time?
+# Can we make _body an attribute and have the rest of these lazy build from there?
+
has _context => (
is => 'rw',
weak_ref => 1,
+ handles => ['read'],
);
has body_parameters => (
default => sub { {} },
);
-before uploads => sub {
- my ($self) = @_;
- #$self->_context->prepare_body;
-};
+# modifier was a noop (groditi)
+# before uploads => sub {
+# my ($self) = @_;
+# #$self->_context->prepare_body;
+# };
has parameters => (
is => 'rw',
You have to set MyApp->config->{parse_on_demand} to use this directly.
-=cut
-
-sub read { shift->_context->read(@_); }
-
=head2 $req->referer
Shortcut for $req->headers->referer. Returns the referring page.
package Catalyst::Request::Upload;
+use Class::C3;
use Moose;
use Catalyst::Exception;
package Catalyst::Response;
+use Class::C3;
use Moose;
use HTTP::Headers;
has _context => (
is => 'rw',
weak_ref => 1,
+ handles => ['write'],
);
sub output { shift->body(@_) }
Writes $data to the output stream.
-=cut
-
-sub write { shift->_context->write(@_); }
-
=head2 meta
Provided by Moose
=cut
no Moose;
-__PACKAGE__->meta->make_immutable();
+#__PACKAGE__->meta->make_immutable();
1;
projects / catagits/Catalyst-Runtime.git / commitdiff