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
  41 __END__
  42
  43 =head1 NAME
  44
  45 CatalystX::DynamicComponent::ModelsFromConfig::InterfaceRoles - Generate simple L<Catalyst::Model::Adaptor> like models from application config, enforcing roles on the model classes.
  46
  47 =head1 SYNOPSIS
  48
  49     package MyApp;
  50     use Moose;
  51     use namespace::autoclean;
  52     use Catalyst qw/
  53         +CatalystX::DynamicComponent::ModelsFromConfig::InterfaceRoles
  54     /;
  55     __PACKAGE__->config(
  56         name => __PACKAGE__,
  57         'CatalystX::DynamicComponent::ModelsFromConfig' => {
  58             include => 'One^',
  59         },
  60         'Model::One' => {
  61             class => 'SomeClass', # Name of class to load and construct
  62             other => 'config',    # Constructor passed other parameters
  63             interface_roles => [qw/ My::Role /], # Your app explodes if SomeClass doesn't do My::Role
  64         },
  65         ...
  66     );
  67     __PACKAGE__->setup;
  68
  69
  70 =head1 DESCRIPTION
  71
  72 FIXME
  73
  74 =head1 LINKS
  75
  76 L<CatalystX::DynamicComponent::ModelsFromConfig>, L<CatalystX::DynamicComponent>, L<Catalyst>.
  77
  78 =head1 BUGS
  79
  80 Probably plenty, test suite certainly isn't comprehensive.. Patches welcome.
  81
  82 =head1 AUTHOR
  83
  84 Tomas Doran (t0m) <bobtfish@bobtfish.net>
  85
  86 =head1 LICENSE
  87
  88 This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl
  89 itself.
  90
  91 =cut
  92