2 package InsideOutClass;
9 use Scalar::Util 'refaddr';
11 our $VERSION = '0.01';
13 __PACKAGE__->meta->superclasses('Class::MOP::Class');
15 sub construct_instance {
16 my ($class, %params) = @_;
17 my $instance = \(my $var);
18 foreach my $attr (map { $_->{attribute} } $class->compute_all_applicable_attributes()) {
19 # if the attr has an init_arg, use that, otherwise,
20 # use the attributes name itself as the init_arg
21 my $init_arg = $attr->has_init_arg() ? $attr->init_arg() : $attr->name;
22 # try to fetch the init arg from the %params ...
24 $val = $params{$init_arg} if exists $params{$init_arg};
25 # if nothing was in the %params, we can use the
26 # attribute's default value (if it has one)
27 $val ||= $attr->default($instance) if $attr->has_default();
28 # now add this to the instance structure
29 $class->get_package_variable('%' . $attr->name)->{ refaddr($instance) } = $val;
35 package InsideOutAttribute;
41 use Scalar::Util 'blessed', 'reftype', 'refaddr';
43 use Class::MOP 'meta';
45 our $VERSION = '0.01';
47 __PACKAGE__->meta->superclasses('Class::MOP::Attribute');
50 # this is just a utility routine to
51 # handle the details of accessors
52 my $_inspect_accessor = sub {
53 my ($attr_name, $type, $accessor) = @_;
55 my %ACCESSOR_TEMPLATES = (
57 $' . $attr_name . '{ refaddr($_[0]) } = $_[1] if scalar(@_) == 2;
58 $' . $attr_name . '{ refaddr($_[0]) };
61 $' . $attr_name . '{ refaddr($_[0]) };
64 $' . $attr_name . '{ refaddr($_[0]) } = $_[1];
67 defined($' . $attr_name . '{ refaddr($_[0]) }) ? 1 : 0;
71 if (reftype($accessor) && reftype($accessor) eq 'HASH') {
72 my ($name, $method) = each %{$accessor};
73 return ($name, Class::MOP::Attribute::Accessor->wrap($method));
76 my $method = eval $ACCESSOR_TEMPLATES{$type};
77 confess "Could not create the $type for $attr_name CODE(\n" . $ACCESSOR_TEMPLATES{$type} . "\n) : $@" if $@;
78 return ($accessor => Class::MOP::Attribute::Accessor->wrap($method));
82 sub install_accessors {
83 my ($self, $class) = @_;
84 (blessed($class) && $class->isa('Class::MOP::Class'))
85 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
87 $class->add_package_variable('%' . $self->name);
90 $_inspect_accessor->($class->name . '::' . $self->name, 'accessor' => $self->accessor())
91 ) if $self->has_accessor();
94 $_inspect_accessor->($class->name . '::' . $self->name, 'reader' => $self->reader())
95 ) if $self->has_reader();
98 $_inspect_accessor->($class->name . '::' . $self->name, 'writer' => $self->writer())
99 ) if $self->has_writer();
102 $_inspect_accessor->($class->name . '::' . $self->name, 'predicate' => $self->predicate())
103 ) if $self->has_predicate();
109 ## &remove_attribute is left as an exercise for the reader :)