factor out metaclass info into roles for compatibility
matthewt [Mon, 20 Apr 2009 16:52:33 +0000 (16:52 +0000)]
lib/Reaction/Meta/Attribute.pm
lib/Reaction/Meta/Class.pm
lib/Reaction/Role/Meta/Attribute.pm [new file with mode: 0644]
lib/Reaction/Role/Meta/Class.pm [new file with mode: 0644]
lib/Reaction/UI/Controller.pm

index b6ea1a0..8b1c055 100644 (file)
@@ -4,67 +4,11 @@ use Moose;
 
 extends 'Moose::Meta::Attribute';
 
-#is => 'Bool' ? or leave it open
-has lazy_fail  =>
-    (is => 'ro', reader => 'is_lazy_fail',  required => 1, default => 0);
-
-around legal_options_for_inheritance => sub {
-  return (shift->(@_), qw/valid_values/);
-};
-
-around _process_options => sub {
-    my $super = shift;
-    my ($class, $name, $options) = @_;
-
-    my $fail  = $options->{lazy_fail};
-
-    if ( $fail ) {
-      confess("You may not use both lazy_build and lazy_fail for one attribute")
-        if $fail && $options->{lazy_build};
-
-      $options->{lazy} = 1;
-      $options->{required} = 1;
-      $options->{default} = sub { confess "${name} must be provided before calling reader" };
-    }
-
-    #we are using this everywhere so might as well move it here.
-    $options->{predicate} ||= ($name =~ /^_/) ? "_has${name}" : "has_${name}"
-      if !$options->{required} || $options->{lazy};
-
-    $super->($class, $name, $options);
-};
-
-foreach my $type (qw(clearer predicate)) {
-
-  my $value_meth = do {
-    if ($type eq 'clearer') {
-      'clear_value'
-    } elsif ($type eq 'predicate') {
-      'has_value'
-    } else {
-      confess "NOTREACHED";
-    }
-  };
-
-  __PACKAGE__->meta->add_method("get_${type}_method" => sub {
-    my $self = shift;
-    my $info = $self->$type;
-    return $info unless ref $info;
-    my ($name) = %$info;
-    return $name;
-  });
-
-  __PACKAGE__->meta->add_method("get_${type}_method_ref" => sub {
-    my $self = shift;
-    if ((my $name = $self->${\"get_${type}_method"}) && $self->associated_class) {
-        return $self->associated_class->get_method($name);
-    } else {
-        return sub { $self->$value_meth(@_); }
-    }
-  });
-}
-
-__PACKAGE__->meta->make_immutable(inline_constructor => 0);
+with 'Reaction::Role::Meta::Attribute';
+
+no Moose;
+
+#__PACKAGE__->meta->make_immutable(inline_constructor => 0);
 
 1;
 
index 5241935..efe243a 100644 (file)
@@ -5,17 +5,10 @@ use Reaction::Meta::Attribute;
 
 extends 'Moose::Meta::Class';
 
-sub new { shift->SUPER::new(@_); }
-
-around initialize => sub {
-    my $super = shift;
-    my $class = shift;
-    my $pkg   = shift;
-    $super->($class, $pkg, 'attribute_metaclass' => 'Reaction::Meta::Attribute', @_ );
-};
+with 'Reaction::Role::Meta::Class';
 
 no Moose;
 
-__PACKAGE__->meta->make_immutable;
+#__PACKAGE__->meta->make_immutable;
 
 1;
diff --git a/lib/Reaction/Role/Meta/Attribute.pm b/lib/Reaction/Role/Meta/Attribute.pm
new file mode 100644 (file)
index 0000000..512cbbb
--- /dev/null
@@ -0,0 +1,110 @@
+package Reaction::Role::Meta::Attribute;
+
+use Moose::Role;
+
+#is => 'Bool' ? or leave it open
+has lazy_fail  =>
+    (is => 'ro', reader => 'is_lazy_fail',  required => 1, default => 0);
+
+around legal_options_for_inheritance => sub {
+  return (shift->(@_), qw/valid_values/);
+};
+
+around _process_options => sub {
+    my $super = shift;
+    my ($class, $name, $options) = @_;
+
+    my $fail  = $options->{lazy_fail};
+
+    if ( $fail ) {
+      confess("You may not use both lazy_build and lazy_fail for one attribute")
+        if $fail && $options->{lazy_build};
+
+      $options->{lazy} = 1;
+      $options->{required} = 1;
+      $options->{default} = sub { confess "${name} must be provided before calling reader" };
+    }
+
+    #we are using this everywhere so might as well move it here.
+    $options->{predicate} ||= ($name =~ /^_/) ? "_has${name}" : "has_${name}"
+      if !$options->{required} || $options->{lazy};
+
+    $super->($class, $name, $options);
+};
+
+foreach my $type (qw(clearer predicate)) {
+
+  my $value_meth = do {
+    if ($type eq 'clearer') {
+      'clear_value'
+    } elsif ($type eq 'predicate') {
+      'has_value'
+    } else {
+      confess "NOTREACHED";
+    }
+  };
+
+  __PACKAGE__->meta->add_method("get_${type}_method" => sub {
+    my $self = shift;
+    my $info = $self->$type;
+    return $info unless ref $info;
+    my ($name) = %$info;
+    return $name;
+  });
+
+  __PACKAGE__->meta->add_method("get_${type}_method_ref" => sub {
+    my $self = shift;
+    if ((my $name = $self->${\"get_${type}_method"}) && $self->associated_class) {
+        return $self->associated_class->get_method($name);
+    } else {
+        return sub { $self->$value_meth(@_); }
+    }
+  });
+}
+
+1;
+
+__END__;
+
+=head1 NAME
+
+Reaction::Meta::Attribute
+
+=head1 SYNOPSIS
+
+    has description => (is => 'rw', isa => 'Str', lazy_fail => 1);
+
+=head1 Method-naming conventions
+
+Reaction::Meta::Attribute will never override the values you set for method names,
+but if you do not it will follow these basic rules:
+
+Attributes with a name that starts with an underscore will default to using
+builder and predicate method names in the form of the attribute name preceeded by
+either "_has" or "_build". Otherwise the method names will be in the form of the
+attribute names preceeded by "has_" or "build_". e.g.
+
+   #auto generates "_has_description" and expects "_build_description"
+   has _description => (is => 'rw', isa => 'Str', lazy_fail => 1);
+
+   #auto generates "has_description" and expects "build_description"
+   has description => (is => 'rw', isa => 'Str', lazy_fail => 1);
+
+=head2 Predicate generation
+
+All non-required or lazy attributes will have a predicate automatically
+generated for them if one is not already specified.
+
+=head2 lazy_fail
+
+lazy_fail will fail if it is called without first having set the value.
+
+=head1 AUTHORS
+
+See L<Reaction::Class> for authors.
+
+=head1 LICENSE
+
+See L<Reaction::Class> for the license.
+
+=cut
diff --git a/lib/Reaction/Role/Meta/Class.pm b/lib/Reaction/Role/Meta/Class.pm
new file mode 100644 (file)
index 0000000..6d91e3f
--- /dev/null
@@ -0,0 +1,12 @@
+package Reaction::Role::Meta::Class;
+
+use Moose::Role;
+
+around initialize => sub {
+    my $super = shift;
+    my $class = shift;
+    my $pkg   = shift;
+    $super->($class, $pkg, 'attribute_metaclass' => 'Reaction::Meta::Attribute', @_ );
+};
+
+1;
index 91da998..a9eeb59 100644 (file)
@@ -1,6 +1,6 @@
 package Reaction::UI::Controller;
 
-use base qw(Catalyst::Controller Reaction::Object);
+use base qw(Catalyst::Controller); # Reaction::Object);
 
 use Reaction::Class;
 use Scalar::Util 'weaken';