lib/CatalystX/DynamicComponent/ModelsFromConfig/InterfaceRoles.pm

   1 package # Hide from PAUSE
   2     CatalystX::DynamicComponent::ModelsFromConfig::InterfaceRoles::COMPONENT;
   3 use Moose::Role;
   4 use Moose::Util qw/does_role/;
   5 use namespace::autoclean;
   6
   7 around 'COMPONENT' => sub {
   8     my ($orig, $component_class_name, $app, $args) = @_;
   9
  10     my $interface_roles = delete $args->{interface_roles};
  11     confess("No interface_roles configuration specified for $component_class_name")
  12         unless $interface_roles && ref($interface_roles) eq 'ARRAY'
  13             && scalar(@$interface_roles);
  14
  15     my $component = $component_class_name->$orig($app, $args);
  16
  17     foreach my $role_name (@$interface_roles) {
  18         confess("$component_class_name generated an instance $component which does not perform the required $role_name role")
  19             unless does_role($component, $role_name);
  20     }
  21
  22     return $component;
  23 };
  24
  25 package CatalystX::DynamicComponent::ModelsFromConfig::InterfaceRoles;
  26 use Moose::Role;
  27 use namespace::autoclean;
  28
  29 with 'CatalystX::DynamicComponent::ModelsFromConfig';
  30
  31 around '_setup_dynamic_model' => sub {
  32     my ($orig, $app, $class_name, $config, @args) = @_;
  33     my @roles = @{ delete($config->{roles}) || [] };
  34     push(@roles, 'CatalystX::DynamicComponent::ModelsFromConfig::InterfaceRoles::COMPONENT');
  35     $config->{roles} = \@roles;
  36     $app->$orig($class_name, $config, @args);
  37 };
  38
  39 1;
  40