importing MooseX-Storage alpha cut (take 2)
[gitmo/MooseX-Storage.git] / lib / MooseX / Storage / Engine.pm
CommitLineData
e59193fb 1
2package MooseX::Storage::Engine;
3use Moose;
4
5has 'storage' => (
6 is => 'rw',
7 isa => 'HashRef',
8 default => sub {{}}
9);
10
11has 'object' => (
12 is => 'rw',
13 isa => 'Object',
14);
15
16sub BUILD {
17 (shift)->collapse_object;
18}
19
20sub collapse_object {
21 my $self = shift;
22 $self->process_attributes;
23 return $self->storage;
24}
25
26sub extract_attributes {
27 my $self = shift;
28 return $self->object->meta->compute_all_applicable_attributes;
29}
30
31sub process_attributes {
32 my $self = shift;
33 foreach my $attr ($self->extract_attributes) {
34 next if $attr->name eq '_storage';
35 $self->process_attribute($attr);
36 }
37}
38
39sub process_attribute {
40 my ($self, $attr) = @_;
41 $self->storage->{$attr->name} = $self->collapse_attribute($attr);
42}
43
44my %TYPES = (
45 'Int' => sub { shift },
46 'Num' => sub { shift },
47 'Str' => sub { shift },
48 'ArrayRef' => sub { shift },
49 'HashRef' => sub { shift },
50 'GlobRef' => sub { confess "FOO" },
51 'CodeRef' => sub { confess "This should use B::Deparse" },
52 'Object' => sub {
53 my $obj = shift;
54 $obj || confess("Object Not Defined");
55 ($obj->does('MooseX::Storage::Base'))
56 || confess "Bad object";
57 $obj->pack();
58 }
59);
60
61sub match_type {
62 my ($self, $type_constraint) = @_;
63 return $TYPES{$type_constraint->name} if exists $TYPES{$type_constraint->name};
64 foreach my $type (keys %TYPES) {
65 return $TYPES{$type}
66 if $type_constraint->is_subtype_of($type);
67 }
68}
69
70sub collapse_attribute {
71 my ($self, $attr) = @_;
72 my $value = $attr->get_value($self->object);
73 if (defined $value && $attr->has_type_constraint) {
74 my $type_converter = $self->match_type($attr->type_constraint);
75 (defined $type_converter)
76 || confess "Cannot convert " . $attr->type_constraint->name;
77 $value = $type_converter->($value);
78 }
79 return $value;
80}
81
821;
83__END__