2 package MooseX::Storage::Engine;
11 has 'object' => (is => 'rw', isa => 'Object');
12 has 'class' => (is => 'rw', isa => 'Str');
14 ## this is the API used by other modules ...
18 $self->map_attributes('collapse_attribute');
19 $self->storage->{'__class__'} = $self->object->meta->name;
20 return $self->storage;
24 my ($self, $data) = @_;
25 $self->map_attributes('expand_attribute', $data);
26 return $self->storage;
29 ## this is the internal API ...
31 sub collapse_attribute {
32 my ($self, $attr) = @_;
33 $self->storage->{$attr->name} = $self->collapse_attribute_value($attr) || return;
36 sub expand_attribute {
37 my ($self, $attr, $data) = @_;
38 $self->storage->{$attr->name} = $self->expand_attribute_value($attr, $data->{$attr->name}) || return;
41 sub collapse_attribute_value {
42 my ($self, $attr) = @_;
43 my $value = $attr->get_value($self->object);
45 # we want to explicitly disallow
46 # cycles here, because the base
47 # storage engine does not support
49 if (defined $value && $attr->has_type_constraint) {
50 my $type_converter = $self->match_type($attr->type_constraint);
51 (defined $type_converter)
52 || confess "Cannot convert " . $attr->type_constraint->name;
53 $value = $type_converter->{collapse}->($value);
58 sub expand_attribute_value {
59 my ($self, $attr, $value) = @_;
61 # we need to check $value here to
62 # make sure that we do not have
64 if (defined $value && $attr->has_type_constraint) {
65 my $type_converter = $self->match_type($attr->type_constraint);
66 $value = $type_converter->{expand}->($value);
74 my ($self, $method_name, @args) = @_;
76 $self->$method_name($_, @args)
77 } ($self->object || $self->class)->meta->compute_all_applicable_attributes;
81 'Int' => { expand => sub { shift }, collapse => sub { shift } },
82 'Num' => { expand => sub { shift }, collapse => sub { shift } },
83 'Str' => { expand => sub { shift }, collapse => sub { shift } },
84 'ArrayRef' => { expand => sub { shift }, collapse => sub { shift } },
85 'HashRef' => { expand => sub { shift }, collapse => sub { shift } },
89 (exists $data->{'__class__'})
90 || confess "Serialized item has no class marker";
91 $data->{'__class__'}->unpack($data);
95 ($obj->can('does') && $obj->does('MooseX::Storage::Base'))
96 || confess "Bad object ($obj) does not do MooseX::Storage::Base role";
103 my ($self, $type_constraint) = @_;
104 return $TYPES{$type_constraint->name} if exists $TYPES{$type_constraint->name};
105 foreach my $type (keys %TYPES) {
107 if $type_constraint->is_subtype_of($type);
110 # from here we can expand this to support the following:
111 # - if it is subtype of Ref
112 # -- if it is a subtype of Object
113 # --- treat it like an object
115 # --- treat it like any other Ref
117 # -- if it is a subtype of Num or Str
118 # --- treat it like Num or Str
121 # this should cover 80% of all use cases
123 # CHRIS: To cover the last 20% we need a way
124 # for people to extend this process.
127 # if this method hasnt returned by now
128 # then we have no been able to find a
129 # type constraint handler to match
130 confess "Cannot handle type constraint (" . $type_constraint->name . ")";