package Catalyst;
-use MRO::Compat;
-use mro '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 || [] }; }
=cut
-sub stash {
+around stash => sub {
+ my $orig = shift;
my $c = shift;
+ my $stash = $orig->($c);
if (@_) {
- my $stash = @_ > 1 ? {@_} : $_[0];
- croak('stash takes a hash or hashref') unless ref $stash;
- foreach my $key ( keys %$stash ) {
- #shouldn't we hold this in a var and save ourselves the subcall?
- $c->next::method->{$key} = $stash->{$key};
+ my $new_stash = @_ > 1 ? {@_} : $_[0];
+ croak('stash takes a hash or hashref') unless ref $new_stash;
+ foreach my $key ( keys %$new_stash ) {
+ $stash->{$key} = $new_stash->{$key};
}
}
- return $c->next::method;
-}
+ return $stash;
+};
=head2 $c->error
=cut
-sub config {
+around config => sub {
+ my $orig = shift;
my $c = shift;
$c->log->warn("Setting config after setup has been run is not a good idea.")
if ( @_ and $c->setup_finished );
- $c->next::method(@_);
-}
+ $c->$orig(@_);
+};
=head2 $c->log
sub setup {
my ( $class, @arguments ) = @_;
- Class::C3::initialize;
$class->log->warn("Running setup twice is not a good idea.")
if ( $class->setup_finished );
$class->log->_flush() if $class->log->can('_flush');
$class->setup_finished(1);
- Class::C3::initialize;
}
=head2 $c->uri_for( $path, @args?, \%query_values? )
=cut
+no Moose;
+
1;
=cut
-use MRO::Compat;
-use mro 'c3';
use Moose;
has class => (is => 'rw');
package Catalyst::ActionChain;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends qw(Catalyst::Action);
=cut
-use MRO::Compat;
-use mro 'c3';
use Moose;
has part => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
has actions => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
-no Moose;
-
-sub new {
- my ($self, $params) = @_;
- $params = { part => $params } unless ref $params;
- $self->next::method($params);
-}
+around new => sub {
+ my ($orig, $self, $params) = @_;
+ $orig->($self, (ref($params) ? $params : { part => $params } ));
+};
+no Moose;
sub get_action {
my ( $self, $name ) = @_;
package Catalyst::Base;
-use MRO::Compat;
-use mro 'c3';
+use base qw/Catalyst::Controller/;
use Moose;
-BEGIN{ extends qw/Catalyst::Controller/ };
no Moose;
1;
package Catalyst::Component;
-use MRO::Compat;
-use mro '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/;
-sub new {
- my ( $self, $c ) = @_;
+around new => sub {
+ my ( $orig, $self) = @_;
# 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 );
- $self->next::method( $args );
-}
+ $self->$orig( $args );
+};
+
+no Moose;
sub COMPONENT {
my ( $self, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
-
-
- #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);
+ return $self->new($c, $arguments);
}
sub config {
package Catalyst::Controller;
#switch to BEGIN { extends qw/ ... /; } ?
-use MRO::Compat;
-use mro 'c3';
use base qw/Catalyst::Component Catalyst::AttrContainer/;
use Moose;
return !@{ $c->error };
}
-sub new {
+around new => sub {
+ my $orig = shift;
my $self = shift;
my $app = $_[0];
- my $new = $self->next::method(@_);
+ my $new = $self->$orig(@_);
$new->_application( $app );
return $new;
-}
+};
sub action_for {
my ( $self, $name ) = @_;
if( ref($self) ){
return $self->$orig if $self->has_action_namespace;
- } else {
+ } else {
return $self->config->{namespace} if exists $self->config->{namespace};
}
package Catalyst::DispatchType;
-use MRO::Compat;
-use mro 'c3';
use Moose; # using it to add Moose::Object to @ISA ...
no Moose;
package Catalyst::DispatchType::Chained;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::DispatchType';
package Catalyst::DispatchType::Default;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::DispatchType';
package Catalyst::DispatchType::Index;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::DispatchType';
no Moose;
package Catalyst::DispatchType::Path;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::DispatchType';
package Catalyst::DispatchType::Regex;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::DispatchType::Path';
package Catalyst::Dispatcher;
-use MRO::Compat;
-use mro 'c3';
use Moose;
use Class::MOP;
package Catalyst::Engine;
-use MRO::Compat;
-use mro 'c3';
use Moose;
with 'MooseX::Emulate::Class::Accessor::Fast';
package Catalyst::Engine::CGI;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::Engine';
has env => (is => 'rw');
-no Moose;
-
=head1 NAME
Catalyst::Engine::CGI - The CGI Engine
=cut
-sub prepare_query_parameters {
+around prepare_query_parameters => sub {
+ my $orig = shift;
my ( $self, $c ) = @_;
local (*ENV) = $self->env || \%ENV;
if ( $ENV{QUERY_STRING} ) {
- $self->next::method( $c, $ENV{QUERY_STRING} );
+ $self->$orig( $c, $ENV{QUERY_STRING} );
}
-}
+};
=head2 $self->prepare_request($c, (env => \%env))
=cut
-sub prepare_write {
+around prepare_write => sub {
*STDOUT->autoflush(1);
- return shift->next::method(@_);
-}
+ return shift->(@_);
+};
=head2 $self->write($c, $buffer)
=cut
-sub write {
+around write => sub {
+ my $orig = shift;
my ( $self, $c, $buffer ) = @_;
# Prepend the headers if they have not yet been sent
$buffer = $headers . $buffer;
}
- return $self->next::method( $c, $buffer );
-}
+ return $self->$orig( $c, $buffer );
+};
=head2 $self->read_chunk($c, $buffer, $length)
the same terms as Perl itself.
=cut
+no Moose;
1;
package Catalyst::Engine::FastCGI;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::Engine::CGI';
package Catalyst::Engine::HTTP;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::Engine::CGI';
-no Moose;
use Data::Dump qw(dump);
use Errno 'EWOULDBLOCK';
=cut
-sub finalize_read {
+around finalize_read => sub {
# 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(@_);
-}
+ shift->(@_);
+};
=head2 $self->prepare_read($c)
=cut
-sub prepare_read {
+around prepare_read => sub {
# Set the input handle to non-blocking
*STDIN->blocking(0);
- shift->next::method(@_);
-}
+ shift->(@_);
+};
=head2 $self->read_chunk($c, $buffer, $length)
=cut
-sub write {
+around write => sub {
+ my $orig = shift;
my ( $self, $c, $buffer ) = @_;
# Avoid 'print() on closed filehandle Remote' warnings when using IE
$buffer = $headers . $buffer;
}
- my $ret = $self->next::method($c, $buffer);
+ my $ret = $self->$orig($c, $buffer);
if ( !defined $ret ) {
$self->{_write_error} = $!;
}
return $ret;
-}
+};
=head2 run
sub _inet_addr { unpack "N*", inet_aton( $_[0] ) }
+no Moose;
+
=head1 SEE ALSO
L<Catalyst>, L<Catalyst::Engine>.
package Catalyst::Engine::HTTP::Restarter;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends 'Catalyst::Engine::HTTP';
-no Moose;
use Catalyst::Engine::HTTP::Restarter::Watcher;
-sub run {
+around run => sub {
+ my $orig = shift;
my ( $self, $class, $port, $host, $options ) = @_;
$options ||= {};
}
}
- return $self->next::method( $class, $port, $host, $options );
+ return $self->$orig( $class, $port, $host, $options );
+ no Moose;
};
1;
package Catalyst::Log;
-use MRO::Compat;
-use mro 'c3';
use Moose;
use Data::Dump;
{
my @levels = qw[ debug info warn error fatal ];
+ my $meta = __PACKAGE__->meta;
for ( my $i = 0 ; $i < @levels ; $i++ ) {
my $name = $levels[$i];
$LEVELS{$name} = $level;
- no strict 'refs';
-
- *{$name} = sub {
+ $meta->add_method($name, sub {
my $self = shift;
if ( $self->level & $level ) {
$self->_log( $name, @_ );
}
- };
+ });
- *{"is_$name"} = sub {
+ $meta->add_method("is_$name", sub {
my $self = shift;
return $self->level & $level;
- };
+ });;
}
}
-sub new {
+around new => sub {
+ my $orig = shift;
my $class = shift;
- my $self = $class->next::method;
+ my $self = $class->$orig;
$self->levels( scalar(@_) ? @_ : keys %LEVELS );
return $self;
-}
+};
sub levels {
my ( $self, @levels ) = @_;
package Catalyst::Model;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends qw/Catalyst::Component/;
package Catalyst::Request;
-use MRO::Compat;
-use mro 'c3';
use IO::Socket qw[AF_INET inet_aton];
use Carp;
use utf8;
package Catalyst::Request::Upload;
-use MRO::Compat;
-use mro 'c3';
use Moose;
use Catalyst::Exception;
package Catalyst::Response;
-use MRO::Compat;
-use mro 'c3';
use Moose;
use HTTP::Headers;
package Catalyst::View;
-use MRO::Compat;
-use mro 'c3';
use Moose;
extends qw/Catalyst::Component/;
projects / catagits/Catalyst-Runtime.git / commitdiff