summaryrefslogtreecommitdiffstats
path: root/lib/MooseX/ArrayRef/Meta/Role/Instance.pm
blob: 1258e79d2d98299632ac9c408ebb779805eb6215 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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;