From c388fb9ba415d6543cff51aa35677f092cc0be93 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 30 Jun 2010 00:25:20 -0500
Subject: basic implementation

---
 lib/MooseX/ArrayRef.pm                    | 12 +++++
 lib/MooseX/ArrayRef/Meta/Role/Class.pm    | 39 ++++++++++++++
 lib/MooseX/ArrayRef/Meta/Role/Instance.pm | 88 +++++++++++++++++++++++++++++++
 3 files changed, 139 insertions(+)
 create mode 100644 lib/MooseX/ArrayRef/Meta/Role/Class.pm
 create mode 100644 lib/MooseX/ArrayRef/Meta/Role/Instance.pm

(limited to 'lib/MooseX')

diff --git a/lib/MooseX/ArrayRef.pm b/lib/MooseX/ArrayRef.pm
index e69de29..6c939e7 100644
--- a/lib/MooseX/ArrayRef.pm
+++ b/lib/MooseX/ArrayRef.pm
@@ -0,0 +1,12 @@
+package MooseX::ArrayRef;
+use Moose::Exporter;
+# ABSTRACT: arrayref-based moose instances
+
+Moose::Exporter->setup_import_methods(
+    class_metaroles => {
+        class    => ['MooseX::ArrayRef::Meta::Role::Class'],
+        instance => ['MooseX::ArrayRef::Meta::Role::Instance'],
+    },
+);
+
+1;
diff --git a/lib/MooseX/ArrayRef/Meta/Role/Class.pm b/lib/MooseX/ArrayRef/Meta/Role/Class.pm
new file mode 100644
index 0000000..0873454
--- /dev/null
+++ b/lib/MooseX/ArrayRef/Meta/Role/Class.pm
@@ -0,0 +1,39 @@
+package MooseX::ArrayRef::Meta::Role::Class;
+use Moose::Role;
+
+use List::MoreUtils qw(any);
+use Data::OptList;
+
+before superclasses => sub {
+    my $self = shift;
+    return if @_ == 0;
+
+    my $supers = Data::OptList::mkopt(\@_);
+    if (@$supers > 1 || any { scalar($_->meta->superclasses) > 1 } $self->linearized_isa) {
+        $self->throw_error("Multiple inheritance is not supported in the inheritance hierarchy of arrayref-based instances");
+    }
+
+    my $super_meta = Class::MOP::Class->initialize($_[0]);
+    if (!Moose::Util::does_role($super_meta->instance_metaclass, 'MooseX::ArrayRef::Meta::Role::Instance') && $super_meta->get_all_attributes) {
+        $self->throw_error("Can't inherit from hashref-based Moose classes");
+    }
+};
+
+before add_attribute => sub {
+    my $self = shift;
+    if ($self->subclasses) {
+        $self->throw_error("Can't add attributes to a class with descendents");
+    }
+};
+
+before rebless_instance => sub {
+    shift->throw_error("Can't rebless arrayref-based instances");
+};
+
+before rebless_instance_back => sub {
+    shift->throw_error("Can't rebless arrayref-based instances");
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/ArrayRef/Meta/Role/Instance.pm b/lib/MooseX/ArrayRef/Meta/Role/Instance.pm
new file mode 100644
index 0000000..1258e79
--- /dev/null
+++ b/lib/MooseX/ArrayRef/Meta/Role/Instance.pm
@@ -0,0 +1,88 @@
+package MooseX::ArrayRef::Meta::Role::Instance;
+use Moose::Role;
+
+my $NOT_EXISTS = \undef;
+
+has slot_mapping => (
+    traits  => ['Hash'],
+    isa     => 'HashRef[Int]',
+    lazy    => 1,
+    default => sub {
+        my $self = shift;
+        my @order = $self->_sorted_slots;
+        return { map { $order[$_] => $_ } 0..$#order };
+    },
+    handles => {
+        slot_index => 'get',
+        num_slots  => 'count',
+    },
+);
+
+sub _sorted_attributes {
+    my $self = shift;
+    return sort {
+        my ($a_name, $b_name) = map { $_->associated_class->name } ($a, $b);
+        $a_name eq $b_name
+            ? $a->insertion_order <=> $b->insertion_order
+            : $a_name->isa($b_name)
+            ?  1
+            : -1;
+
+    } $self->get_all_attributes;
+}
+
+sub _sorted_slots {
+    my $self = shift;
+    return map { sort $_->slots } $self->_sorted_attributes;
+}
+
+sub create_instance {
+    my $self = shift;
+    bless [($NOT_EXISTS) x $self->num_slots], $self->_class_name;
+}
+
+sub clone_instance {
+    my ($self, $instance) = @_;
+    bless [ @$instance ], $self->_class_name;
+}
+
+sub get_slot_value {
+    my ($self, $instance, $slot_name) = @_;
+    my $val = $instance->[$self->slot_index($slot_name)];
+    return $val unless ref($val);
+    return undef if $val == $NOT_EXISTS;
+    return $val;
+}
+
+sub set_slot_value {
+    my ($self, $instance, $slot_name, $value) = @_;
+    $instance->[$self->slot_index($slot_name)] = $value;
+}
+
+sub initialize_slot {
+    my ($self, $instance, $slot_name) = @_;
+    $instance->[$self->slot_index($slot_name)] = $NOT_EXISTS;
+}
+
+sub deinitialize_slot {
+    my ($self, $instance, $slot_name) = @_;
+    $instance->[$self->slot_index($slot_name)] = $NOT_EXISTS;
+}
+
+sub is_slot_initialized {
+    my ($self, $instance, $slot_name) = @_;
+    my $val = $instance->[$self->slot_index($slot_name)];
+    !ref($val) || $val != $NOT_EXISTS;
+}
+
+sub weaken_slot_value {
+    my ($self, $instance, $slot_name) = @_;
+    weaken $instance->[$self->slot_index($slot_name)];
+}
+
+# TODO
+sub is_inlinable { 0 }
+
+no Moose::Role;
+
+1;
-- 
cgit v1.2.3-54-g00ecf