diff options
| -rw-r--r-- | lib/Reaction/Meta/Attribute.pm | 66 | ||||
| -rw-r--r-- | lib/Reaction/Meta/Class.pm | 11 | ||||
| -rw-r--r-- | lib/Reaction/Role/Meta/Attribute.pm | 110 | ||||
| -rw-r--r-- | lib/Reaction/Role/Meta/Class.pm | 12 | ||||
| -rw-r--r-- | lib/Reaction/UI/Controller.pm | 2 |
5 files changed, 130 insertions, 71 deletions
diff --git a/lib/Reaction/Meta/Attribute.pm b/lib/Reaction/Meta/Attribute.pm index b6ea1a0..8b1c055 100644 --- a/lib/Reaction/Meta/Attribute.pm +++ b/lib/Reaction/Meta/Attribute.pm @@ -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; diff --git a/lib/Reaction/Meta/Class.pm b/lib/Reaction/Meta/Class.pm index 5241935..efe243a 100644 --- a/lib/Reaction/Meta/Class.pm +++ b/lib/Reaction/Meta/Class.pm @@ -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 index 0000000..512cbbb --- /dev/null +++ b/lib/Reaction/Role/Meta/Attribute.pm @@ -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 index 0000000..6d91e3f --- /dev/null +++ b/lib/Reaction/Role/Meta/Class.pm @@ -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; diff --git a/lib/Reaction/UI/Controller.pm b/lib/Reaction/UI/Controller.pm index 91da998..a9eeb59 100644 --- a/lib/Reaction/UI/Controller.pm +++ b/lib/Reaction/UI/Controller.pm @@ -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'; |