Reaction::InterfaceModel::Reflector::DBIC - Reaction::InterfaceModel::Reflector::DBIC documentation

Reaction documentation Contained in the Reaction distribution.

Index

Code Index:

NAME

Top

Reaction::InterfaceModel::Reflector::DBIC - Automatically Generate InterfaceModels from DBIx::Class models

DESCRIPTION

Top

The InterfaceModel reflectors are classes that are meant to aid you in easily generating Reaction::InterfaceModel classes that represent their underlying DBIx::Class domain models by introspecting your DBIx::Class::ResultSources and creating a collection of Reaction::InterfaceModel::Object and Reaction::InterfaceModel::Collection classes for you to use.

The default base class of all Object classes will beReaction::InterfaceModel::Object and the default Collection type will be Reaction::InterfaceModel::Collection::Virtual::ResultSet.

Additionally, the reflector can create InterfaceModel actions that interact with the supplied Reaction::UI::Controller::Collection::CRUD, allowing you to easily set up a highly customizable CRUD interface in minimal time.

At this time, supported collection actions consist of:

Reaction::InterfaceModel::Action::DBIC::ResultSet::Create

Creates a new item in the collection and underlying ResultSet.

Reaction::InterfaceModel::Action::DBIC::ResultSet::DeleteAll

Deletes all the items in a collection and it's underlying resultset using delete_all

And supported object actions are :

Update - via Reaction::InterfaceModel::Action::DBIC::Result::Update

Updates an existing object.

Delete - via Reaction::InterfaceModel::Action::DBIC::Result::Delete

Deletes an existing object.

SYNOPSIS

Top

    package MyApp::IM::TestModel;
    use base 'Reaction::InterfaceModel::Object';
    use Reaction::Class;
    use Reaction::InterfaceModel::Reflector::DBIC;
    my $reflector = Reaction::InterfaceModel::Reflector::DBIC->new;

    #Reflect everything
    $reflector->reflect_schema
      (
       model_class  => __PACKAGE__,
       schema_class => 'MyApp::Schema',
      );

Selectively including and excluding sources

    #reflect everything except for the FooBar and FooBaz classes
    $reflector->reflect_schema
      (
       model_class  => __PACKAGE__,
       schema_class => 'MyApp::Schema',
       sources => [-exclude => [qw/FooBar FooBaz/] ],
       # you could also do:
       sources => [-exclude => qr/(?:FooBar|FooBaz)/,
       # or even
       sources => [-exclude => [qr/FooBar/, qr/FooBaz/],
      );

    #reflect only the Foo family of sources
    $reflector->reflect_schema
      (
       model_class  => __PACKAGE__,
       schema_class => 'MyApp::Schema',
       sources => qr/^Foo/,
      );

Selectively including and excluding fields in sources

    #Reflect Foo and Baz in their entirety and exclude the field 'avatar' in the Bar ResultSource
    $reflector->reflect_schema
      (
       model_class  => __PACKAGE__,
       schema_class => 'MyApp::Schema',
       sources => [qw/Foo Baz/,
                   [ Bar => {attributes => [[-exclude => 'avatar']] } ],
                   # or exclude by regex
                   [ Bar => {attributes => [-exclude => qr/avatar/] } ],
                   # or simply do not include it...
                   [ Bar => {attributes => [qw/id name description/] } ],
                  ],
      );

ATTRIBUTES

Top

make_classes_immutable

object_actions

collection_actions

default_object_actions

default_collection_actions

builtin_object_actions

builtin_collection_actions

METHODS

Top

new

_all_object_actions

_all_collection_actions

dm_name_from_class_name

dm_name_from_source_name

class_name_from_source_name

class_name_for_collection_of

merge_hashes

parse_reflect_rules

merge_reflect_rules

reflect_schema

_compute_source_options

add_source

reflect_source

reflect_source_collection

reflect_source_object

reflect_source_object_attribute

parameters_for_source_object_attribute

reflect_source_action

parameters_for_source_object_action_attribute

TODO

Top

Allow the reflector to dump the generated code out as files, eliminating the need to reflect on startup every time. This will likely take quite a bit of work though. The main work is already in place, but the grunt work is still left. At the moment there is no closures that can't be dumped out as code with a little bit of work.

AUTHORS

Top

See Reaction::Class for authors.

LICENSE

Top

See Reaction::Class for the license.

Reaction documentation Contained in the Reaction distribution. 
package Reaction::InterfaceModel::Reflector::DBIC;

use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create';
use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::DeleteAll';
use aliased 'Reaction::InterfaceModel::Action::DBIC::Result::Update';
use aliased 'Reaction::InterfaceModel::Action::DBIC::Result::Delete';

use aliased 'Reaction::InterfaceModel::Collection::Virtual::ResultSet';
use aliased 'Reaction::InterfaceModel::Object';
use aliased 'Reaction::InterfaceModel::Action';
use Reaction::Class;
use Class::MOP;

use Catalyst::Utils;

use namespace::clean -except => [ qw(meta) ];

has make_classes_immutable => (isa => "Bool", is => "rw", required => 1, default => sub{ 1 });

#user defined actions and prototypes
has object_actions     => (isa => "HashRef", is => "rw", lazy_build => 1);
has collection_actions => (isa => "HashRef", is => "rw", lazy_build => 1);

#which actions to create by default
has default_object_actions     => (isa => "ArrayRef", is => "rw", lazy_build => 1);
has default_collection_actions => (isa => "ArrayRef", is => "rw", lazy_build => 1);

#builtin actions and prototypes
has builtin_object_actions     => (isa => "HashRef", is => "rw", lazy_build => 1);
has builtin_collection_actions => (isa => "HashRef", is => "rw", lazy_build => 1);
sub _build_object_actions { {} };
sub _build_collection_actions { {} };
sub _build_default_object_actions { [ qw/Update Delete/ ] };
sub _build_default_collection_actions { [ qw/Create DeleteAll/ ] };
sub _build_builtin_object_actions {
  {
    Update => { name => 'Update', base => Update },
    Delete => { name => 'Delete', base => Delete, attributes => [] },
  };
};
sub _build_builtin_collection_actions {
  {
    Create    => {name => 'Create',    base => Create    },
    DeleteAll => {name => 'DeleteAll', base => DeleteAll, attributes => [] }
  };
};
sub _all_object_actions {
 my $self = shift;
  return $self->merge_hashes
    ($self->builtin_object_actions, $self->object_actions);
};
sub _all_collection_actions {
  my $self = shift;
  return $self->merge_hashes
    ($self->builtin_collection_actions, $self->collection_actions);
};
sub dm_name_from_class_name {
  my($self, $class) = @_;
  confess("wrong arguments") unless $class;
  $class =~ s/::/_/g;
  $class = "_" . $self->_class_to_attribute_name($class) . "_store";
  return $class;
};
sub dm_name_from_source_name {
  my($self, $source) = @_;
  confess("wrong arguments") unless $source;
  $source =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ;
  $source = "_" . $self->_class_to_attribute_name($source) . "_store";
  return $source;
};
sub class_name_from_source_name {
  my ($self, $model_class, $source_name) = @_;
  confess("wrong arguments") unless $model_class && $source_name;
  return join "::", $model_class, $source_name;
};
sub class_name_for_collection_of {
  my ($self, $object_class) = @_;
  confess("wrong arguments") unless $object_class;
  return "${object_class}::Collection";
};
sub merge_hashes {
  my($self, $left, $right) = @_;
  return Catalyst::Utils::merge_hashes($left, $right);
};
sub parse_reflect_rules {
  my ($self, $rules, $haystack) = @_;
  confess('$rules must be an array reference')    unless ref $rules    eq 'ARRAY';
  confess('$haystack must be an array reference') unless ref $haystack eq 'ARRAY';

  my $needles = {};
  my (@exclude, @include, $global_opts);
  if(@$rules == 2 && $rules->[0] eq '-exclude'){
    push(@exclude, (ref $rules->[1] eq 'ARRAY' ? @{$rules->[1]} : $rules->[1]));
  } else {
    for my $rule ( @$rules ){
      if (ref $rule eq 'ARRAY' && $rule->[0] eq '-exclude'){
        push(@exclude, (ref $rule->[1] eq 'ARRAY' ? @{$rule->[1]} : $rule->[1]));
      } elsif( ref $rule eq 'HASH' ){
        $global_opts = ref $global_opts eq 'HASH' ?
          $self->merge_hashes($global_opts, $rule) : $rule;
      } else {
        push(@include, $rule);
      }
    }
  }
  my $check_exclude = sub{
    for my $rule (@exclude){
      return 1 if(ref $rule eq 'Regexp' ? $_[0] =~ /$rule/ : $_[0] eq $rule);
    }
    return;
  };

  @$haystack = grep { !$check_exclude->($_) } @$haystack;
  $self->merge_reflect_rules(\@include, $needles, $haystack, $global_opts);
  return $needles;
};
sub merge_reflect_rules {
  my ($self, $rules, $needles, $haystack, $local_opts) = @_;
  for my $rule ( @$rules ){
    if(!ref $rule && ( grep {$rule eq $_} @$haystack ) ){
      $needles->{$rule} = defined $needles->{$rule} ?
        $self->merge_hashes($needles->{$rule}, $local_opts) : $local_opts;
    } elsif( ref $rule eq 'Regexp' ){
      for my $match ( grep { /$rule/ } @$haystack ){
        $needles->{$match} = defined $needles->{$match} ?
          $self->merge_hashes($needles->{$match}, $local_opts) : $local_opts;
      }
    } elsif( ref $rule eq 'ARRAY' ){
      my $opts;
      $opts = pop(@$rule) if @$rule > 1 and ref $rule->[$#$rule] eq 'HASH';
      $opts = $self->merge_hashes($local_opts, $opts) if defined $local_opts;
      $self->merge_reflect_rules($rule, $needles, $haystack, $opts);
    }
  }
};
sub reflect_schema {
  my ($self, %opts) = @_;
  my $base    = delete $opts{base} || Object;
  my $roles   = delete $opts{roles} || [];
  my $model   = delete $opts{model_class};
  my $schema  = delete $opts{schema_class};
  my $dm_name = delete $opts{domain_model_name};
  my $dm_args = delete $opts{domain_model_args} || {};
  $dm_name ||= $self->dm_name_from_class_name($schema);

  #load all necessary classes
  confess("model_class and schema_class are required parameters")
    unless($model && $schema);
  Class::MOP::load_class( $base );
  Class::MOP::load_class( $schema );
  my $meta = $self->_load_or_create(
    $model,
    superclasses => [$base],
    ( @$roles ? (roles => $roles) : ()),
  );

  # sources => undef,              #default to qr/./
  # sources => [],                 #default to nothing
  # sources => qr//,               #DWIM, treated as [qr//]
  # sources => [{...}]             #DWIM, treat as [qr/./, {...} ]
  # sources => [[-exclude => ...]] #DWIM, treat as [qr/./, [-exclude => ...]]
  my $haystack = [ $schema->sources ];

  my $rules = delete $opts{sources};
  if(!defined $rules){
    $rules = [qr/./];
  } elsif( ref $rules eq 'Regexp'){
    $rules = [ $rules ];
  } elsif( ref $rules eq 'ARRAY' && @$rules){
    #don't add a qr/./ rule if we have at least one match rule
    push(@$rules, qr/./) unless grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
                                        || !ref $_  || ref $_ eq 'Regexp'} @$rules;
  }

  my $sources = $self->parse_reflect_rules($rules, $haystack);

  my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;
  $meta->make_mutable if $meta->is_immutable;

  $meta->add_domain_model
    ($dm_name, is => 'rw', isa => $schema, required => 1, %$dm_args);

  for my $source_name (keys %$sources){
    my $source_opts = $sources->{$source_name} || {};
    $self->reflect_source(
                          source_name  => $source_name,
                          parent_class => $model,
                          schema_class => $schema,
                          source_class => $schema->class($source_name),
                          parent_domain_model_name => $dm_name,
                          %$source_opts
                         );
  }

  $meta->make_immutable if $make_immutable;
  return $meta;
};
sub _compute_source_options {
  my ($self, %opts) = @_;
  my $schema       = delete $opts{schema_class};
  my $source_name  = delete $opts{source_name};
  my $source_class = delete $opts{source_class};
  my $parent       = delete $opts{parent_class};
  my $parent_dm    = delete $opts{parent_domain_model_name};

  #this is the part where I hate my life for promissing all sorts of DWIMery
  confess("parent_class and source_name or source_class are required parameters")
    unless($parent && ($source_name || $source_class));

OUTER: until( $schema && $source_name && $source_class && $parent_dm ){
    if( $schema && !$source_name){
      next OUTER if $source_name = $schema->source($source_class)->source_name;
    } elsif( $schema && !$source_class){
      next OUTER if $source_class = eval { $schema->class($source_name) };
    }

    my @haystack = $parent_dm ? $parent->meta->find_attribute_by_name($parent_dm) : ();

    #there's a lot of guessing going on, but it should work fine on most cases
  INNER: for my $needle (@haystack){
      my $isa = $needle->_isa_metadata;
      next INNER unless Class::MOP::load_class( $isa->_isa_metadata );
      next INNER unless $isa->isa('DBIx::Class::Schema');

      if( $source_name ){
        my $src_class = eval{ $isa->class($source_name) };
        next INNER unless $src_class;
        next INNER if($source_class && $source_class ne $src_class);
        $schema = $isa;
        $parent_dm = $needle->name;
        $source_class = $src_class;
        next OUTER;
      }
    }


    confess("Could not determine options automatically from: schema " .
            "'${schema}', source_name '${source_name}', source_class " .
            "'${source_class}', parent_domain_model_name '${parent_dm}'");
  }

  return {
          source_name  => $source_name,
          schema_class => $schema,
          source_class => $source_class,
          parent_class => $parent,
          parent_domain_model_name => $parent_dm,
         };
};
sub _class_to_attribute_name {
  my ( $self, $str ) = @_;
  confess("wrong arguments passed for _class_to_attribute_name") unless $str;
  return join('_', map lc, split(/::|(?<=[a-z0-9])(?=[A-Z])/, $str))
};
sub add_source {
  my ($self, %opts) = @_;

  my $model      = delete $opts{model_class};
  my $reader     = delete $opts{reader};
  my $source     = delete $opts{source_name};
  my $dm_name    = delete $opts{domain_model_name};
  my $collection = delete $opts{collection_class};
  my $name       = delete $opts{attribute_name} || $source;

  confess("model_class and source_name are required parameters")
    unless $model && $source;
  my $meta = $model->meta;

  unless( $collection ){
    my $object = $self->class_name_from_source_name($model, $source);
    $collection = $self->class_name_for_collection_of($object);
  }
  unless( $reader ){
    $reader = $source;
    $reader =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ;
    $reader = $self->_class_to_attribute_name($reader) . "_collection";
  }
  unless( $dm_name ){
    my @haystack = $meta->domain_models;
    if( @haystack > 1 ){
      @haystack = grep { $_->_isa_metadata->isa('DBIx::Class::Schema') } @haystack;
    }
    if(@haystack == 1){
      $dm_name = $haystack[0]->name;
    } elsif(@haystack > 1){
      confess("Failed to automatically determine domain_model_name. More than one " .
              "possible match (".(join ", ", map{"'".$_->name."'"} @haystack).")");
    } else {
      confess("Failed to automatically determine domain_model_name. No matches.");
    }
  }

  my %attr_opts =
    (
     lazy           => 1,
     required       => 1,
     isa            => $collection,
     reader         => $reader,
     predicate      => "has_" . $self->_class_to_attribute_name($name) ,
     domain_model   => $dm_name,
     orig_attr_name => $source,
     default        => sub {
       $collection->new
         (
          _source_resultset => $_[0]->$dm_name->resultset($source),
          _parent           => $_[0],
         );
     },
    );

  my $make_immutable = $meta->is_immutable;
  $meta->make_mutable   if $make_immutable;
  my $attr = $meta->add_attribute($name, %attr_opts);
  $meta->make_immutable if $make_immutable;

  return $attr;
};
sub reflect_source {
  my ($self, %opts) = @_;
  my $collection  = delete $opts{collection} || {};
  %opts = %{ $self->merge_hashes(\%opts, $self->_compute_source_options(%opts)) };

  my $obj_meta = $self->reflect_source_object(%opts);
  my $col_meta = $self->reflect_source_collection
    (
     object_class => $obj_meta->name,
     source_class => $opts{source_class},
     schema => $opts{schema_class},
     %$collection
    );

  $self->add_source(
                    %opts,
                    model_class       => delete $opts{parent_class},
                    domain_model_name => delete $opts{parent_domain_model_name},
                    collection_class  => $col_meta->name,
                   );
};
sub reflect_source_collection {
  my ($self, %opts) = @_;
  my $base    = delete $opts{base} || ResultSet;
  my $roles   = delete $opts{roles} || [];
  my $class   = delete $opts{class};
  my $object  = delete $opts{object_class};
  my $source  = delete $opts{source_class};
  my $action_rules = delete $opts{actions};
  my $schema = delete $opts{schema};

  confess('object_class and source_class are required parameters')
    unless $object && $source;
  $class ||= $self->class_name_for_collection_of($object);

  Class::MOP::load_class( $base );
  Class::MOP::load_class( $object );

  my $meta = $self->_load_or_create(
    $class,
    superclasses => [$base],
    ( @$roles ? (roles => $roles) : ()),
  );

  my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;;
  $meta->make_mutable if $meta->is_immutable;
  $meta->add_method(_build_member_type => sub{ $object } );
  #XXX as a default pass the domain model as a target_model until i come up with something
  #better through the coercion method
  my $def_act_args = sub {
    my $super = shift;
    return { (target_model => $_[0]->_source_resultset), %{ $super->(@_) } };
  };
  $meta->add_around_method_modifier('_default_action_args_for', $def_act_args);


  {
    my $all_actions = $self->_all_collection_actions;
    my $action_haystack = [keys %$all_actions];
    if(!defined $action_rules){
      $action_rules = $self->default_collection_actions;
    } elsif( (!ref $action_rules && $action_rules) || (ref $action_rules eq 'Regexp') ){
      $action_rules = [ $action_rules ];
    } elsif( ref $action_rules eq 'ARRAY' && @$action_rules){
      #don't add a qr/./ rule if we have at least one match rule
      push(@$action_rules, qr/./)
        unless grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
                       || !ref $_  || ref $_ eq 'Regexp'} @$action_rules;
    }

    # XXX this is kind of a dirty hack to support custom actions that are not
    # previously defined and still be able to use the parse_reflect_rules mechanism
    my @custom_actions = grep {!exists $all_actions->{$_}}
      map{ $_->[0] } grep {ref $_ eq 'ARRAY' && $_->[0] ne '-exclude'} @$action_rules;
    push(@$action_haystack, @custom_actions);
    my $actions = $self->parse_reflect_rules($action_rules, $action_haystack);
    for my $action (keys %$actions){
      my $action_opts = $self->merge_hashes
        ($all_actions->{$action} || {}, $actions->{$action} || {});

      #NOTE: If the name of the action is not specified in the prototype then use it's
      #hash key as the name. I think this is sane beahvior, but I've actually been thinking
      #of making Action prototypes their own separate objects
      $self->reflect_source_action(
                                   schema => $schema,
                                   name         => $action,
                                   object_class => $object,
                                   source_class => $source,
                                   %$action_opts,
                                  );

      # XXX i will move this to use the coercion method soon. this will be
      #  GoodEnough until then. I still need to think a little about the type coercion
      #  thing so i don't make a mess of it
      my $act_args = sub {   #override target model for this action
        my $super = shift;
        return { %{ $super->(@_) },
                 ($_[1] eq $action ? (target_model => $_[0]->_source_resultset) : () ) };
      };
      $meta->add_around_method_modifier('_default_action_args_for', $act_args);
    }
  }
  $meta->make_immutable if $make_immutable;
  return $meta;
};
sub reflect_source_object {
  my($self, %opts) = @_;
  %opts = %{ $self->merge_hashes(\%opts, $self->_compute_source_options(%opts)) };

  my $base = delete $opts{base} || Object;
  my $roles = delete $opts{roles} || [];
  my $class = delete $opts{class};
  my $dm_name = delete $opts{domain_model_name};
  my $dm_opts = delete $opts{domain_model_args} || {};

  my $source_name  = delete $opts{source_name};
  my $schema       = delete $opts{schema_class};
  my $source_class = delete $opts{source_class};
  my $parent       = delete $opts{parent_class};
  my $parent_dm    = delete $opts{parent_domain_model_name};

  my $action_rules = delete $opts{actions};
  my $attr_rules   = delete $opts{attributes};

  $class ||= $self->class_name_from_source_name($parent, $source_name);

  Class::MOP::load_class($parent);
  Class::MOP::load_class($schema) if $schema;
  Class::MOP::load_class($source_class);

  my $meta = $self->_load_or_create(
    $class,
    superclasses => [$base],
    ( @$roles ? (roles => $roles) : ()),
  );

  #create the domain model
  $dm_name ||= $self->dm_name_from_source_name($source_name);

  $dm_opts->{isa}        = $source_class;
  $dm_opts->{is}       ||= 'rw';
  $dm_opts->{required} ||= 1;

  my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;;
  $meta->make_mutable if $meta->is_immutable;

  my $dm_attr   = $meta->add_domain_model($dm_name, %$dm_opts);
  my $dm_reader = $dm_attr->get_read_method;

  unless( $class->can('inflate_result') ){
    my $inflate_method = sub {
      my $class = shift; my ($src) = @_;
      $src = $src->resolve if $src->isa('DBIx::Class::ResultSourceHandle');
      $class->new($dm_name, $src->result_class->inflate_result(@_));
    };
    $meta->add_method('inflate_result', $inflate_method);
  }

  #XXX this is here to allow action prototypes to work with ListView
  # maybe Collections hsould have this kind of thing too to allow you to reconstruct them?
  #i like the possibility to be honest... as aset of key/value pairs they could be URId
  #XXX move to using 'handles' for this?
  $meta->add_method('__id', sub {shift->$dm_reader->id} )
    unless $class->can('__id');
  #XXX this one is for Action, ChooseOne and ChooseMany need this shit
  $meta->add_method('__ident_condition', sub {shift->$dm_reader->ident_condition} )
    unless $class->can('__ident_condition');

  #XXX this is just a disaster
  $meta->add_method('display_name', sub {shift->$dm_reader->display_name} )
    if( $source_class->can('display_name') && !$class->can('display_name'));

  #XXX as a default pass the domain model as a target_model until i come up with something
  #better through the coercion method
  my $def_act_args = sub {
    my $super = shift;
    confess "no dm reader: $dm_reader on $_[0]" unless $_[0]->can($dm_reader);
    return { (target_model => $_[0]->$dm_reader), %{ $super->(@_) } };
  };
  $meta->add_around_method_modifier('_default_action_args_for', $def_act_args);

  {
    # attributes => undef,              #default to qr/./
    # attributes => [],                 #default to nothing
    # attributes => qr//,               #DWIM, treated as [qr//]
    # attributes => [{...}]             #DWIM, treat as [qr/./, {...} ]
    # attributes => [[-exclude => ...]] #DWIM, treat as [qr/./, [-exclude => ...]]
    my $attr_haystack =
      [ map { $_->name } $source_class->meta->get_all_attributes ];

    if(!defined $attr_rules){
      $attr_rules = [qr/./];
    } elsif( (!ref $attr_rules && $attr_rules) || (ref $attr_rules eq 'Regexp') ){
      $attr_rules = [ $attr_rules ];
    } elsif( ref $attr_rules eq 'ARRAY' && @$attr_rules){
      #don't add a qr/./ rule if we have at least one match rule
      push(@$attr_rules, qr/./) unless
        grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
                || !ref $_  || ref $_ eq 'Regexp'} @$attr_rules;
    }

    my $attributes = $self->parse_reflect_rules($attr_rules, $attr_haystack);
    for my $attr_name (keys %$attributes){
      $self->reflect_source_object_attribute(
                                             schema => $schema,
                                             class             => $class,
                                             source_class      => $source_class,
                                             parent_class      => $parent,
                                             attribute_name    => $attr_name,
                                             domain_model_name => $dm_name,
                                             %{ $attributes->{$attr_name} || {}},
                                            );
    }
  }

  {
    my $all_actions = $self->_all_object_actions;
    my $action_haystack = [keys %$all_actions];
    if(!defined $action_rules){
      $action_rules = $self->default_object_actions;
    } elsif( (!ref $action_rules && $action_rules) || (ref $action_rules eq 'Regexp') ){
      $action_rules = [ $action_rules ];
    } elsif( ref $action_rules eq 'ARRAY' && @$action_rules){
      #don't add a qr/./ rule if we have at least one match rule
      push(@$action_rules, qr/./)
        unless grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
                       || !ref $_  || ref $_ eq 'Regexp'} @$action_rules;
    }

    # XXX this is kind of a dirty hack to support custom actions that are not
    # previously defined and still be able to use the parse_reflect_rules mechanism
    my @custom_actions = grep {!exists $all_actions->{$_}} map{ $_->[0] }
      grep {ref $_ eq 'ARRAY' && $_->[0] ne '-exclude'} @$action_rules;
    push(@$action_haystack, @custom_actions);
    my $actions = $self->parse_reflect_rules($action_rules, $action_haystack);
    for my $action (keys %$actions){
      my $action_opts = $self->merge_hashes
        ($all_actions->{$action} || {}, $actions->{$action} || {});

      #NOTE: If the name of the action is not specified in the prototype then use it's
      #hash key as the name. I think this is sane beahvior, but I've actually been thinking
      #of making Action prototypes their own separate objects
      $self->reflect_source_action(
                                   schema => $schema,
                                   name         => $action,
                                   object_class => $class,
                                   source_class => $source_class,
                                   %$action_opts,
                                  );

      # XXX i will move this to use the coercion method soon. this will be
      #  GoodEnough until then. I still need to think a little about the type coercion
      #  thing so i don't make a mess of it
      my $act_args = sub {   #override target model for this action
        my $super = shift;
        confess "no dm reader: $dm_reader on $_[0]" unless $_[0]->can($dm_reader);
        return { %{ $super->(@_) },
                 ($_[1] eq $action ? (target_model => $_[0]->$dm_reader) : () ) };
      };
      $meta->add_around_method_modifier('_default_action_args_for', $act_args);
    }
  }

  $meta->make_immutable if $make_immutable;
  return $meta;
};

# needs class, attribute_name domain_model_name
sub reflect_source_object_attribute {
  my ($self, %opts) = @_;
  unless( $opts{attribute_name} && $opts{class} && $opts{parent_class}
          && ( $opts{source_class} || $opts{domain_model_name} ) ){
    confess( "Error: class, parent_class, attribute_name, and either " .
             "domain_model_name or source_class are required parameters" );
  }

  my $meta =  $opts{class}->meta;
  my $attr_opts = $self->parameters_for_source_object_attribute(%opts);

  my $make_immutable = $meta->is_immutable;
  $meta->make_mutable if $meta->is_immutable;

  my $attr = $meta->add_attribute($opts{attribute_name}, %$attr_opts);

  $meta->make_immutable if $make_immutable;
  return $attr;
};

# needs class, attribute_name domain_model_name
sub parameters_for_source_object_attribute {
  my ($self, %opts) = @_;

  my $class        = delete $opts{class};
  my $attr_name    = delete $opts{attribute_name};
  my $dm_name      = delete $opts{domain_model_name};
  my $source_class = delete $opts{source_class};
  my $parent_class = delete $opts{parent_class};
  my $schema = $opts{schema};
  confess("parent_class is a required argument") unless $parent_class;
  confess("You must supply at least one of domain_model_name and source_class")
    unless $dm_name || $source_class;

  my $source = $schema->source($source_class);
  my $from_attr = $source_class->meta->find_attribute_by_name($attr_name);
  my $reader = $from_attr->get_read_method;
  die("Could not find reader for attribute '$attr_name' on $source_class")
    unless $reader;

  #default options. lazy build but no outsider method
  my %attr_opts = ( is => 'ro', lazy => 1, required => 1,
                    clearer   => "_clear_${attr_name}",
                    predicate => {
                        "has_${attr_name}" =>
                            sub { defined(shift->$dm_name->$reader) }
                    },
                    domain_model   => $dm_name,
                    orig_attr_name => $attr_name,
                  );
  $attr_opts{coerce} = 1 if $from_attr->should_coerce;

  #m2m / has_many
  my $m2m_meta;
  if(my $coderef = $source->result_class->can('_m2m_metadata')){
    $m2m_meta = $source->result_class->$coderef;
  }

  my $constraint_is_ArrayRef =
    $from_attr->type_constraint->name eq 'ArrayRef' ||
      $from_attr->type_constraint->is_subtype_of('ArrayRef');

  if( my $rel_info = $source->relationship_info($attr_name) ){
    my $rel_accessor = $rel_info->{attrs}->{accessor};
    my $rel_moniker  = $schema->source($rel_info->{class})->source_name;

    if($rel_accessor eq 'multi' && $constraint_is_ArrayRef) {
      #has_many
      my $sm = $self->class_name_from_source_name($parent_class, $rel_moniker);
      #type constraint is a collection, and default builds it
      my $isa = $attr_opts{isa} = $self->class_name_for_collection_of($sm);
      $attr_opts{default} = eval "sub {
                my \$rs = shift->${dm_name}->related_resultset('${attr_name}');
                return ${isa}->new(_source_resultset => \$rs);
            }";
    } elsif( $rel_accessor eq 'single' || $rel_accessor eq 'filter' ) {
      #belongs_to
      #type constraint is the foreign IM object, default inflates it
      my $isa = $attr_opts{isa} = $self->class_name_from_source_name($parent_class, $rel_moniker);
      $attr_opts{default} = eval "sub {
                if (defined(my \$o = shift->${dm_name}->${reader})) {
                    return ${isa}->inflate_result(\$o->result_source, { \$o->get_columns });
                }
                return undef;
            }";
    }
  } elsif( $constraint_is_ArrayRef && $attr_name =~ m/^(.*)_list$/ ) {
    #m2m magic
    my $mm_name = $1;
    my $link_table = "links_to_${mm_name}_list";
    my ($hm_source, $far_side);
    eval { $hm_source = $source->related_source($link_table); }
      || confess "Can't find ${link_table} has_many for ${mm_name}_list";
    eval { $far_side = $hm_source->related_source($mm_name); }
      || confess "Can't find ${mm_name} belongs_to on ".$hm_source->result_class
        ." traversing many-many for ${mm_name}_list";

    my $sm = $self->class_name_from_source_name($parent_class,$far_side->source_name);
    my $isa = $attr_opts{isa} = $self->class_name_for_collection_of($sm);

    #proper collections will remove the result_class uglyness.
    $attr_opts{default} = eval "sub {
            my \$rs = shift->${dm_name}->related_resultset('${link_table}')->related_resultset('${mm_name}');
            return ${isa}->new(_source_resultset => \$rs);
        }";
  } elsif( $constraint_is_ArrayRef && defined $m2m_meta && exists $m2m_meta->{$attr_name} ){
    #m2m if using introspectable m2m component
    my $rel = $m2m_meta->{$attr_name}->{relation};
    my $far_rel   = $m2m_meta->{$attr_name}->{foreign_relation};
    my $far_source = $source->related_source($rel)->related_source($far_rel);
    my $sm = $self->class_name_from_source_name($parent_class, $far_source->source_name);
    my $isa = $attr_opts{isa} = $self->class_name_for_collection_of($sm);

    my $rs_meth = $m2m_meta->{$attr_name}->{rs_method};
    $attr_opts{default} = eval "sub {
            return ${isa}->new(_source_resultset => shift->${dm_name}->${rs_meth});
        }";
  } else {
    #no rel
    $attr_opts{isa} = $from_attr->_isa_metadata;
    my $default_code = "sub{ shift->${dm_name}->${reader} }";
    $attr_opts{default} = eval $default_code;
    die "Could not generate default for attribute, code '$default_code' did not compile with: $@" if $@;
  }
  return \%attr_opts;
};
sub reflect_source_action {
  my($self, %opts) = @_;
  my $name = delete $opts{name};
  my $base = delete $opts{base} || Action;
  my $roles = delete $opts{roles} || [];
  my $class = delete $opts{class};
  my $object = delete $opts{object_class};
  my $source = delete $opts{source_class};
  my $schema = delete $opts{schema};

  confess("name, object_class and source_class are required arguments")
    unless $source && $name && $object;

  my $attr_rules = delete $opts{attributes};
  $class ||= $object->_default_action_class_for($name);

  Class::MOP::load_class( $base   );
  Class::MOP::load_class( $object );
  Class::MOP::load_class( $source );

  #print STDERR "\n\t", ref $attr_rules eq 'ARRAY' ? @$attr_rules : $attr_rules,"\n";
  # attributes => undef,              #default to qr/./
  # attributes => [],                 #default to nothing
  # attributes => qr//,               #DWIM, treated as [qr//]
  # attributes => [{...}]             #DWIM, treat as [qr/./, {...} ]
  # attributes => [[-exclude => ...]] #DWIM, treat as [qr/./, [-exclude => ...]]
  my $attr_haystack = [ map { $_->name } $object->parameter_attributes ];
  if(!defined $attr_rules){
    $attr_rules = [qr/./];
  } elsif( (!ref $attr_rules && $attr_rules) || (ref $attr_rules eq 'Regexp') ){
    $attr_rules = [ $attr_rules ];
  } elsif( ref $attr_rules eq 'ARRAY' && @$attr_rules){
    #don't add a qr/./ rule if we have at least one match rule
    push(@$attr_rules, qr/./) unless
      grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
              || !ref $_  || ref $_ eq 'Regexp'} @$attr_rules;
  }

  #print STDERR "${name}\t${class}\t${base}\n";
  #print STDERR "\t${object}\t${source}\n";
  #print STDERR "\t",@$attr_rules,"\n";

  my $o_meta = $object->meta;
  my $s_meta = $source->meta;
  my $attributes = $self->parse_reflect_rules($attr_rules, $attr_haystack);

  #create the class
  my $meta = $self->_load_or_create(
    $class,
    superclasses => [$base],
    ( @$roles ? (roles => $roles) : ()),
  );
  my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;
  $meta->make_mutable if $meta->is_immutable;

  for my $attr_name (keys %$attributes){
    my $attr_opts   = $attributes->{$attr_name} || {};
    my $o_attr      = $o_meta->find_attribute_by_name($attr_name);
    my $s_attr_name = $o_attr->orig_attr_name || $attr_name;
    my $s_attr      = $s_meta->find_attribute_by_name($s_attr_name);
    confess("Unable to find attribute for '${s_attr_name}' via '${source}'")
      unless defined $s_attr;
    next unless $s_attr->get_write_method
      && $s_attr->get_write_method !~ /^_/; #only rw attributes!

    my $attr_params = $self->parameters_for_source_object_action_attribute
      (
       schema => $schema,
       object_class   => $object,
       source_class   => $source,
       attribute_name => $attr_name
      );
    $meta->add_attribute( $attr_name => %$attr_params);
  }

  $meta->make_immutable if $make_immutable;
  return $meta;
};
sub parameters_for_source_object_action_attribute {
  my ($self, %opts) = @_;

  my $object       = delete $opts{object_class};
  my $attr_name    = delete $opts{attribute_name};
  my $source_class = delete $opts{source_class};
  my $schema = delete $opts{schema};
  my $source = $schema->source($source_class);
  confess("object_class and attribute_name are required parameters")
    unless $attr_name && $object;

  my $o_meta  = $object->meta;
  my $dm_name = $o_meta->find_attribute_by_name($attr_name)->domain_model;
  $source_class ||= $o_meta->find_attribute_by_name($dm_name)->_isa_metadata;
  my $from_attr = $source_class->meta->find_attribute_by_name($attr_name);

  #print STDERR "$attr_name is type: " . $from_attr->meta->name . "\n";

  confess("${attr_name} is not writeable and can not be reflected")
    unless $from_attr->get_write_method;

  my %attr_opts = (
                   is        => 'rw',
                   isa       => $from_attr->_isa_metadata,
                   required  => $from_attr->is_required,
                   ($from_attr->is_required
                     ? () : (clearer => "clear_${attr_name}")),
                   predicate => "has_${attr_name}",
                  );

  if ($attr_opts{required}) {
      if($from_attr->has_default) {
        $attr_opts{lazy} = 1;
        $attr_opts{default} = $from_attr->default;
      } else {
        $attr_opts{lazy_fail} = 1;
      }
  }


  my $m2m_meta;
  if(my $coderef = $source_class->result_class->can('_m2m_metadata')){
    $m2m_meta = $source_class->result_class->$coderef;
  }
  #test for relationships
  my $constraint_is_ArrayRef =
    $from_attr->type_constraint->name eq 'ArrayRef' ||
      $from_attr->type_constraint->is_subtype_of('ArrayRef');

  if (my $rel_info = $source->relationship_info($attr_name)) {
    my $rel_accessor = $rel_info->{attrs}->{accessor};

    if($rel_accessor eq 'multi' && $constraint_is_ArrayRef) {
      confess "${attr_name} is a rw has_many, this won't work.";
    } elsif( $rel_accessor eq 'single' || $rel_accessor eq 'filter') {
      $attr_opts{valid_values} = sub {
        shift->target_model->result_source->related_source($attr_name)->resultset;
      };
    }
  } elsif ( $constraint_is_ArrayRef && $attr_name =~ m/^(.*)_list$/) {
    my $mm_name = $1;
    my $link_table = "links_to_${mm_name}_list";
    $attr_opts{default} = sub { [] };
    $attr_opts{valid_values} = sub {
      shift->target_model->result_source->related_source($link_table)
        ->related_source($mm_name)->resultset;
    };
  } elsif( $constraint_is_ArrayRef && defined $m2m_meta && exists $m2m_meta->{$attr_name} ){
    #m2m if using introspectable m2m component
    my $rel = $m2m_meta->{$attr_name}->{relation};
    my $far_rel   = $m2m_meta->{$attr_name}->{foreign_relation};
    $attr_opts{default} = sub { [] };
    $attr_opts{valid_values} = sub {
      shift->target_model->result_source->related_source($rel)
        ->related_source($far_rel)->resultset;
    };
  }
  #use Data::Dumper;
  #print STDERR "\n" .$attr_name ." - ". $object . "\n";
  #print STDERR Dumper(\%attr_opts);
  return \%attr_opts;
};

sub _load_or_create {
  my ($self, $class, %options) = @_;

  if( $self->_maybe_load_class($class) ){
    return $class->meta;
  }
  my $base;
  if( exists $options{superclasses} ){
    ($base) = @{ $options{superclasses} };
  } else {
    $base = 'Reaction::InterfaceModel::Action';
  }
  return $base->meta->create($class, %options);
}

sub _maybe_load_class {
  my ($self, $class) = @_;
  my $file = $class . '.pm';
  $file =~ s{::}{/}g;
  my $ret = eval { Class::MOP::load_class($class) };
  if ($INC{$file} && $@) {
    confess "Error loading ${class}: $@";
  }
  return $ret;
}

__PACKAGE__->meta->make_immutable;


1;

#--------#---------#---------#---------#---------#---------#---------#---------#
__END__;