lib/Catalyst/IOC/Service/WithAcceptContext.pm

   1 package Catalyst::IOC::Service::WithAcceptContext;
   2 use Moose::Role;
   3
   4 has accept_context_sub => (
   5     is => 'ro',
   6     isa => 'Str',
   7     default => 'ACCEPT_CONTEXT',
   8 );
   9
  10 around get => sub {
  11     my $orig   = shift;
  12     my $self   = shift;
  13
  14     my $accept_context_args = $self->param('accept_context_args');
  15     my $ac_sub = $self->accept_context_sub;
  16
  17     my $instance = $self->$orig(@_);
  18
  19     if ( $accept_context_args && $instance->can($ac_sub) ) {
  20         # FIXME - MADNESS!
  21         # how the heck does this warn CODE???????????
  22         warn ref $accept_context_args if ref $accept_context_args ne 'ARRAY';
  23         return $instance->$ac_sub( @$accept_context_args );
  24     }
  25
  26     return $instance;
  27 };
  28
  29 no Moose::Role;
  30 1;
  31
  32 __END__
  33
  34 =pod
  35
  36 =head1 NAME
  37
  38 Catalyst::IOC::Service::WithAcceptContext
  39
  40 =head1 DESCRIPTION
  41
  42 =head1 ATTRIBUTES
  43
  44 =head2 accept_context_sub
  45
  46 =head1 AUTHORS
  47
  48 Catalyst Contributors, see Catalyst.pm
  49
  50 =head1 COPYRIGHT
  51
  52 This library is free software. You can redistribute it and/or modify it under
  53 the same terms as Perl itself.
  54
  55 =cut