madness.

[catagits/Catalyst-Runtime.git] / lib / Catalyst / IOC / Service / WithAcceptContext.pm

package Catalyst::IOC::Service::WithAcceptContext;
use Moose::Role;

has accept_context_sub => (
    is => 'ro',
    isa => 'Str',
    default => 'ACCEPT_CONTEXT',
);

around get => sub {
    my $orig   = shift;
    my $self   = shift;

    my $accept_context_args = $self->param('accept_context_args');
    my $ac_sub = $self->accept_context_sub;

    my $instance = $self->$orig(@_);

    if ( $accept_context_args && $instance->can($ac_sub) ) {
        # FIXME - MADNESS!
        # how the heck does this warn CODE???????????
        warn ref $accept_context_args if ref $accept_context_args ne 'ARRAY';
        return $instance->$ac_sub( @$accept_context_args );
    }

    return $instance;
};

no Moose::Role;
1;

__END__

=pod

=head1 NAME

Catalyst::IOC::Service::WithAcceptContext

=head1 DESCRIPTION

=head1 ATTRIBUTES

=head2 accept_context_sub

=head1 AUTHORS

Catalyst Contributors, see Catalyst.pm

=head1 COPYRIGHT

This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.

=cut