[catagits/Catalyst-Runtime.git] / lib / Catalyst / Controller.pm

package Catalyst::Controller;

use Moose;
use Class::MOP ();
#use MooseX::ClassAttribute;
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

=head1 SYNOPSIS

  package MyApp::Controller::Search
  use base qw/Catalyst::Controller/;

  sub foo : Local {
    my ($self,$c,@args) = @_;
    ...
  } # Dispatches to /search/foo

=head1 DESCRIPTION

Controllers are where the actions in the Catalyst framework
reside. Each action is represented by a function with an attribute to
identify what kind of action it is. See the L<Catalyst::Dispatcher>
for more info about how Catalyst dispatches to actions.

=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;
};


sub _DISPATCH : Private {
    my ( $self, $c ) = @_;

    foreach my $disp ( @{ $self->_dispatch_steps } ) {
        last unless $c->forward($disp);
    }

    $c->forward('_END');
}

sub _BEGIN : Private {
    my ( $self, $c ) = @_;
    my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
    return 1 unless $begin;
    $begin->dispatch( $c );
    return !@{ $c->error };
}

sub _AUTO : Private {
    my ( $self, $c ) = @_;
    my @auto = $c->get_actions( 'auto', $c->namespace );
    foreach my $auto (@auto) {
        $auto->dispatch( $c );
        return 0 unless $c->state;
    }
    return 1;
}

sub _ACTION : Private {
    my ( $self, $c ) = @_;
    if (   ref $c->action
        && $c->action->can('execute')
        && $c->req->action )
    {
        $c->action->dispatch( $c );
    }
    return !@{ $c->error };
}

sub _END : Private {
    my ( $self, $c ) = @_;
    my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
    return 1 unless $end;
    $end->dispatch( $c );
    return !@{ $c->error };
}

sub action_for {
    my ( $self, $name ) = @_;
    my $app = ($self->isa('Catalyst') ? $self : $self->_application);
    return $app->dispatcher->get_action($name, $self->action_namespace);
}

sub action_namespace {
    my ( $self, $c ) = @_;
    unless ( $c ) {
        $c = ($self->isa('Catalyst') ? $self : $self->_application);
    }
    my $hash = (ref $self ? $self : $self->config); # hate app-is-class
    return $hash->{namespace} if exists $hash->{namespace};
    return Catalyst::Utils::class2prefix( ref($self) || $self,
        $c->config->{case_sensitive} )
      || '';
}

sub path_prefix {
    my ( $self, $c ) = @_;
    unless ( $c ) {
        $c = ($self->isa('Catalyst') ? $self : $self->_application);
    }
    my $hash = (ref $self ? $self : $self->config); # hate app-is-class
    return $hash->{path} if exists $hash->{path};
    return shift->action_namespace(@_);
}


sub register_actions {
    my ( $self, $c ) = @_;
    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);
    }

    #Moose TODO: something tells me that roles could kill the directly code below
    # Advanced inheritance support for plugins and the like
    my @action_cache;
    {
        no strict 'refs';
        for my $isa ( @{"$class\::ISA"}, $class ) {
            push @action_cache, @{ $isa->_action_cache }
              if $isa->can('_action_cache');
        }
    }

    foreach my $cache (@action_cache) {
        my $code   = $cache->[0];
        my $method = delete $methods{$code}; # avoid dupe registers
        next unless $method;
        my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
        if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
            $c->log->debug( 'Bad action definition "'
                  . join( ' ', @{ $cache->[1] } )
                  . qq/" for "$class->$method"/ )
              if $c->debug;
            next;
        }
        my $reverse = $namespace ? "$namespace/$method" : $method;
        my $action = $self->create_action(
            name       => $method,
            code       => $code,
            reverse    => $reverse,
            namespace  => $namespace,
            class      => $class,
            attributes => $attrs,
        );

        $c->dispatcher->register( $c, $action );
    }
}

sub create_action {
    my $self = shift;
    my %args = @_;

    my $class = (exists $args{attributes}{ActionClass}
                    ? $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);

    return $class->new( \%args );
}

sub _parse_attrs {
    my ( $self, $c, $name, @attrs ) = @_;

    my %raw_attributes;

    foreach my $attr (@attrs) {

        # Parse out :Foo(bar) into Foo => bar etc (and arrayify)

        if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
        {

            if ( defined $value ) {
                ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
            }
            push( @{ $raw_attributes{$key} }, $value );
        }
    }

    my $hash = (ref $self ? $self : $self->config); # hate app-is-class

    if (exists $hash->{actions} || exists $hash->{action}) {
      my $a = $hash->{actions} || $hash->{action};
      %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()),
                         %raw_attributes,
                         (exists $a->{$name} ? %{$a->{$name}} : ()));
    }

    my %final_attributes;

    foreach my $key (keys %raw_attributes) {

        my $raw = $raw_attributes{$key};

        foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {

            my $meth = "_parse_${key}_attr";
            if ( $self->can($meth) ) {
                ( $key, $value ) = $self->$meth( $c, $name, $value );
            }
            push( @{ $final_attributes{$key} }, $value );
        }
    }

    return \%final_attributes;
}

sub _parse_Global_attr {
    my ( $self, $c, $name, $value ) = @_;
    return $self->_parse_Path_attr( $c, $name, "/$name" );
}

sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }

sub _parse_Local_attr {
    my ( $self, $c, $name, $value ) = @_;
    return $self->_parse_Path_attr( $c, $name, $name );
}

sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }

sub _parse_Path_attr {
    my ( $self, $c, $name, $value ) = @_;
    $value ||= '';
    if ( $value =~ m!^/! ) {
        return ( 'Path', $value );
    }
    elsif ( length $value ) {
        return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
    }
    else {
        return ( 'Path', $self->path_prefix($c) );
    }
}

sub _parse_Regex_attr {
    my ( $self, $c, $name, $value ) = @_;
    return ( 'Regex', $value );
}

sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }

sub _parse_LocalRegex_attr {
    my ( $self, $c, $name, $value ) = @_;
    unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
    return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
}

sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }

sub _parse_ActionClass_attr {
    my ( $self, $c, $name, $value ) = @_;
    unless ( $value =~ s/^\+// ) {
      $value = join('::', $self->_action_class, $value );
    }
    return ( 'ActionClass', $value );
}

sub _parse_MyAction_attr {
    my ( $self, $c, $name, $value ) = @_;

    my $appclass = Catalyst::Utils::class2appclass($self);
    $value = "${appclass}::Action::${value}";

    return ( 'ActionClass', $value );
}

1;

__END__

=head1 CONFIGURATION

Like any other L<Catalyst::Component>, controllers have a config hash,
accessible through $self->config from the controller actions.  Some
settings are in use by the Catalyst framework:

=head2 namespace

This specifies the internal namespace the controller should be bound
to. By default the controller is bound to the URI version of the
controller name. For instance controller 'MyApp::Controller::Foo::Bar'
will be bound to 'foo/bar'. The default Root controller is an example
of setting namespace to '' (the null string).

=head2 path

Sets 'path_prefix', as described below.

=head1 METHODS

=head2 $class->new($app, @args)

Proxies through to NEXT::new and stashes the application instance as
$self->_application.

=head2 $self->action_for('name')

Returns the Catalyst::Action object (if any) for a given method name
in this component.

=head2 $self->register_actions($c)

Finds all applicable actions for this component, creates
Catalyst::Action objects (using $self->create_action) for them and
registers them with $c->dispatcher.

=head2 $self->action_namespace($c)

Returns the private namespace for actions in this component. Defaults
to a value from the controller name (for
e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
overridden from the "namespace" config key.


=head2 $self->path_prefix($c)

Returns the default path prefix for :Local, :LocalRegex and relative
:Path actions in this component. Defaults to the action_namespace or
can be overridden from the "path" config key.

=head2 $self->create_action(%args)

Called with a hash of data to be use for construction of a new
Catalyst::Action (or appropriate sub/alternative class) object.

Primarily designed for the use of register_actions.

=head2 $self->_application

=head2 $self->_app

Returns the application instance stored by C<new()>

=head1 AUTHOR

Sebastian Riedel, C<sri@oook.de>
Marcus Ramberg C<mramberg@cpan.org>

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
Commit	Line	Data
5ee249f2	1	package Catalyst::Controller;
5ee249f2	2
6323fda2	3	use Moose;
	4	use Class::MOP ();
	5	#use MooseX::ClassAttribute;
234763d4	6	use Catalyst::Exception;
	7	use Catalyst::Utils;
	8	use Class::Inspector;
	9	use NEXT;
5ee249f2	10
6323fda2	11	#extends qw/Catalyst::Component Catalyst::AttrContainer/;
	12	use base qw/Catalyst::Component Catalyst::AttrContainer/;
	13
	14	# class_has _dispatch_steps =>
	15	# (
	16	# is => 'rw',
	17	# isa => 'ArrayRef',
	18	# required => 1,
	19	# default => sub{ [qw/_BEGIN _AUTO _ACTION/] },
	20	# );
	21
	22	# class_has _action_class =>
	23	# (
	24	# is => 'rw',
	25	# isa => 'ClassName',
	26	# required => 1,
	27	# default => sub{ 'Catalyst::Action' },
	28	# );
	29
	30	__PACKAGE__->mk_classdata('_dispatch_steps');
	31	__PACKAGE__->mk_classdata('_action_class');
	32
	33	__PACKAGE__->_action_class('Catalyst::Action');
	34	__PACKAGE__->_dispatch_steps([qw/_BEGIN _AUTO _ACTION/]);
	35
	36
	37	has _application => ( is => 'rw' );
	38	### _app as alias
	39	_app = _application;
	40
5ee249f2	41	=head1 NAME
	42
	43	Catalyst::Controller - Catalyst Controller base class
	44
	45	=head1 SYNOPSIS
	46
234763d4	47	package MyApp::Controller::Search
a269e0c2	48	use base qw/Catalyst::Controller/;
234763d4	49
6323fda2	50	sub foo : Local {
85d9fce6	51	my ($self,$c,@args) = @_;
6323fda2	52	...
234763d4	53	} # Dispatches to /search/foo
5ee249f2	54
	55	=head1 DESCRIPTION
	56
a269e0c2	57	Controllers are where the actions in the Catalyst framework
	58	reside. Each action is represented by a function with an attribute to
	59	identify what kind of action it is. See the L<Catalyst::Dispatcher>
	60	for more info about how Catalyst dispatches to actions.
234763d4	61
	62	=cut
	63
6323fda2	64	# just emulating old behavior. we could probably do this
	65	# via BUILD later or pass $app as application => $app
	66	around new => sub {
	67	my $orig = shift;
	68	my $self = shift;
	69	my $app = $_[0];
	70	my $new = $self->$orig(@_);
	71	$new->_application( $app );
	72	return $new;
	73	};
234763d4	74
234763d4	75
	76	sub _DISPATCH : Private {
	77	my ( $self, $c ) = @_;
	78
	79	foreach my $disp ( @{ $self->_dispatch_steps } ) {
	80	last unless $c->forward($disp);
	81	}
	82
	83	$c->forward('_END');
	84	}
	85
	86	sub _BEGIN : Private {
	87	my ( $self, $c ) = @_;
	88	my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
	89	return 1 unless $begin;
	90	$begin->dispatch( $c );
	91	return !@{ $c->error };
	92	}
	93
	94	sub _AUTO : Private {
	95	my ( $self, $c ) = @_;
	96	my @auto = $c->get_actions( 'auto', $c->namespace );
	97	foreach my $auto (@auto) {
	98	$auto->dispatch( $c );
	99	return 0 unless $c->state;
	100	}
	101	return 1;
	102	}
	103
	104	sub _ACTION : Private {
	105	my ( $self, $c ) = @_;
	106	if ( ref $c->action
	107	&& $c->action->can('execute')
	108	&& $c->req->action )
	109	{
	110	$c->action->dispatch( $c );
	111	}
	112	return !@{ $c->error };
	113	}
	114
	115	sub _END : Private {
	116	my ( $self, $c ) = @_;
	117	my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
	118	return 1 unless $end;
	119	$end->dispatch( $c );
	120	return !@{ $c->error };
	121	}
	122
234763d4	123	sub action_for {
	124	my ( $self, $name ) = @_;
	125	my $app = ($self->isa('Catalyst') ? $self : $self->_application);
	126	return $app->dispatcher->get_action($name, $self->action_namespace);
	127	}
	128
	129	sub action_namespace {
	130	my ( $self, $c ) = @_;
	131	unless ( $c ) {
	132	$c = ($self->isa('Catalyst') ? $self : $self->_application);
	133	}
	134	my $hash = (ref $self ? $self : $self->config); # hate app-is-class
	135	return $hash->{namespace} if exists $hash->{namespace};
	136	return Catalyst::Utils::class2prefix( ref($self) \|\| $self,
	137	$c->config->{case_sensitive} )
	138	\|\| '';
	139	}
	140
	141	sub path_prefix {
	142	my ( $self, $c ) = @_;
	143	unless ( $c ) {
	144	$c = ($self->isa('Catalyst') ? $self : $self->_application);
	145	}
	146	my $hash = (ref $self ? $self : $self->config); # hate app-is-class
	147	return $hash->{path} if exists $hash->{path};
	148	return shift->action_namespace(@_);
	149	}
	150
	151
	152	sub register_actions {
	153	my ( $self, $c ) = @_;
	154	my $class = ref $self \|\| $self;
	155	my $namespace = $self->action_namespace($c);
	156	my %methods;
6323fda2	157	{
	158	my $meth_map = $class->meta->get_method_map;
	159	@methods{values %$meth_map} = (keys %$meth_map);
	160	}
234763d4	161
6323fda2	162	#Moose TODO: something tells me that roles could kill the directly code below
234763d4	163	# Advanced inheritance support for plugins and the like
	164	my @action_cache;
	165	{
	166	no strict 'refs';
	167	for my $isa ( @{"$class\::ISA"}, $class ) {
	168	push @action_cache, @{ $isa->_action_cache }
	169	if $isa->can('_action_cache');
	170	}
	171	}
	172
	173	foreach my $cache (@action_cache) {
	174	my $code = $cache->[0];
	175	my $method = delete $methods{$code}; # avoid dupe registers
	176	next unless $method;
	177	my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
	178	if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
	179	$c->log->debug( 'Bad action definition "'
	180	. join( ' ', @{ $cache->[1] } )
	181	. qq/" for "$class->$method"/ )
	182	if $c->debug;
	183	next;
	184	}
	185	my $reverse = $namespace ? "$namespace/$method" : $method;
	186	my $action = $self->create_action(
	187	name => $method,
	188	code => $code,
	189	reverse => $reverse,
	190	namespace => $namespace,
	191	class => $class,
	192	attributes => $attrs,
	193	);
	194
	195	$c->dispatcher->register( $c, $action );
	196	}
	197	}
	198
	199	sub create_action {
	200	my $self = shift;
	201	my %args = @_;
	202
	203	my $class = (exists $args{attributes}{ActionClass}
	204	? $args{attributes}{ActionClass}[0]
	205	: $self->_action_class);
	206
6323fda2	207	#can we replace with a single call to Class::MOP::load_class() ?
	208	#unless ( Class::Inspector->loaded($class) ) {
	209	# require Class::Inspector->filename($class);
	210	#}
	211	Class::MOP::load_class($class);
	212
234763d4	213	return $class->new( \%args );
	214	}
	215
	216	sub _parse_attrs {
	217	my ( $self, $c, $name, @attrs ) = @_;
	218
	219	my %raw_attributes;
	220
	221	foreach my $attr (@attrs) {
	222
	223	# Parse out :Foo(bar) into Foo => bar etc (and arrayify)
	224
	225	if ( my ( $key, $value ) = ( $attr =~ /^(.?)(?:\(\s(.+?)\s*\))?$/ ) )
	226	{
	227
	228	if ( defined $value ) {
	229	( $value =~ s/^'(.)'$/$1/ ) \|\| ( $value =~ s/^"(.)"/$1/ );
	230	}
	231	push( @{ $raw_attributes{$key} }, $value );
	232	}
	233	}
	234
	235	my $hash = (ref $self ? $self : $self->config); # hate app-is-class
	236
	237	if (exists $hash->{actions} \|\| exists $hash->{action}) {
	238	my $a = $hash->{actions} \|\| $hash->{action};
	239	%raw_attributes = ((exists $a->{''} ? %{$a->{''}} : ()),
	240	%raw_attributes,
	241	(exists $a->{$name} ? %{$a->{$name}} : ()));
	242	}
	243
	244	my %final_attributes;
	245
	246	foreach my $key (keys %raw_attributes) {
	247
	248	my $raw = $raw_attributes{$key};
	249
	250	foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
	251
	252	my $meth = "_parse_${key}_attr";
	253	if ( $self->can($meth) ) {
	254	( $key, $value ) = $self->$meth( $c, $name, $value );
	255	}
	256	push( @{ $final_attributes{$key} }, $value );
	257	}
	258	}
	259
	260	return \%final_attributes;
	261	}
	262
	263	sub _parse_Global_attr {
	264	my ( $self, $c, $name, $value ) = @_;
	265	return $self->_parse_Path_attr( $c, $name, "/$name" );
	266	}
	267
	268	sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
	269
	270	sub _parse_Local_attr {
	271	my ( $self, $c, $name, $value ) = @_;
	272	return $self->_parse_Path_attr( $c, $name, $name );
	273	}
	274
	275	sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
	276
277	sub _parse_Path_attr {
278	my ( $self, $c, $name, $value ) = @_;
279	$value \|\|= '';
280	if ( $value =~ m!^/! ) {
281	return ( 'Path', $value );
282	}
283	elsif ( length $value ) {
284	return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
285	}
286	else {
287	return ( 'Path', $self->path_prefix($c) );
288	}
289	}
290
291	sub _parse_Regex_attr {
292	my ( $self, $c, $name, $value ) = @_;
293	return ( 'Regex', $value );
294	}
295
296	sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
297
298	sub _parse_LocalRegex_attr {
299	my ( $self, $c, $name, $value ) = @_;
300	unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
301	return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
302	}
303
304	sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
305
306	sub _parse_ActionClass_attr {
307	my ( $self, $c, $name, $value ) = @_;
308	unless ( $value =~ s/^\+// ) {
309	$value = join('::', $self->_action_class, $value );
310	}
311	return ( 'ActionClass', $value );
312	}
313
9287719b	314	sub _parse_MyAction_attr {
	315	my ( $self, $c, $name, $value ) = @_;
	316
	317	my $appclass = Catalyst::Utils::class2appclass($self);
	318	$value = "${appclass}::Action::${value}";
234763d4	319
9287719b	320	return ( 'ActionClass', $value );
9287719b	321	}
234763d4	322
	323	1;
	324
	325	__END__
	326
	327	=head1 CONFIGURATION
	328
a269e0c2	329	Like any other L<Catalyst::Component>, controllers have a config hash,
	330	accessible through $self->config from the controller actions. Some
	331	settings are in use by the Catalyst framework:
234763d4	332
	333	=head2 namespace
	334
a269e0c2	335	This specifies the internal namespace the controller should be bound
	336	to. By default the controller is bound to the URI version of the
	337	controller name. For instance controller 'MyApp::Controller::Foo::Bar'
	338	will be bound to 'foo/bar'. The default Root controller is an example
	339	of setting namespace to '' (the null string).
234763d4	340
6323fda2	341	=head2 path
234763d4	342
	343	Sets 'path_prefix', as described below.
	344
	345	=head1 METHODS
	346
	347	=head2 $class->new($app, @args)
	348
	349	Proxies through to NEXT::new and stashes the application instance as
	350	$self->_application.
	351
	352	=head2 $self->action_for('name')
	353
a269e0c2	354	Returns the Catalyst::Action object (if any) for a given method name
a269e0c2	355	in this component.
234763d4	356
	357	=head2 $self->register_actions($c)
	358
a269e0c2	359	Finds all applicable actions for this component, creates
	360	Catalyst::Action objects (using $self->create_action) for them and
	361	registers them with $c->dispatcher.
234763d4	362
	363	=head2 $self->action_namespace($c)
	364
a269e0c2	365	Returns the private namespace for actions in this component. Defaults
	366	to a value from the controller name (for
	367	e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
	368	overridden from the "namespace" config key.
234763d4	369
	370
	371	=head2 $self->path_prefix($c)
	372
a269e0c2	373	Returns the default path prefix for :Local, :LocalRegex and relative
	374	:Path actions in this component. Defaults to the action_namespace or
	375	can be overridden from the "path" config key.
234763d4	376
	377	=head2 $self->create_action(%args)
	378
a269e0c2	379	Called with a hash of data to be use for construction of a new
a269e0c2	380	Catalyst::Action (or appropriate sub/alternative class) object.
234763d4	381
	382	Primarily designed for the use of register_actions.
	383
a269e0c2	384	=head2 $self->_application
234763d4	385
	386	=head2 $self->_app
	387
	388	Returns the application instance stored by C<new()>
5ee249f2	389
	390	=head1 AUTHOR
	391
	392	Sebastian Riedel, C<sri@oook.de>
234763d4	393	Marcus Ramberg C<mramberg@cpan.org>
5ee249f2	394
	395	=head1 COPYRIGHT
	396
a269e0c2	397	This program is free software, you can redistribute it and/or modify
a269e0c2	398	it under the same terms as Perl itself.
5ee249f2	399
5ee249f2	400	=cut