X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FStorage%2FEngine.pm;h=ec96c707c7a318aa94ad37aaf8b37fcfd00f7ec9;hb=45d9a73cb319d9cd4d3e30d07526d72cb3e11ad2;hp=4e801b7112e396f295920f4eeecf5c64c54fa2b6;hpb=bff7e5f724df04544cca9d3c4ed91777910f2194;p=gitmo%2FMooseX-Storage.git diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index 4e801b7..ec96c70 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -2,8 +2,20 @@ package MooseX::Storage::Engine; use Moose; +our $VERSION = '0.02'; + +# the class marker when +# serializing an object. +our $CLASS_MARKER = '__CLASS__'; + has 'storage' => ( - is => 'rw', + is => 'ro', + isa => 'HashRef', + default => sub {{}} +); + +has 'seen' => ( + is => 'ro', isa => 'HashRef', default => sub {{}} ); @@ -15,13 +27,23 @@ has 'class' => (is => 'rw', isa => 'Str'); sub collapse_object { my $self = shift; + + # NOTE: + # mark the root object as seen ... + $self->seen->{$self->object} = undef; + $self->map_attributes('collapse_attribute'); - $self->storage->{'__class__'} = $self->object->meta->name; + $self->storage->{$CLASS_MARKER} = $self->object->meta->name; return $self->storage; } sub expand_object { my ($self, $data) = @_; + + # NOTE: + # mark the root object as seen ... + $self->seen->{$data} = undef; + $self->map_attributes('expand_attribute', $data); return $self->storage; } @@ -41,13 +63,16 @@ sub expand_attribute { sub collapse_attribute_value { my ($self, $attr) = @_; my $value = $attr->get_value($self->object); - # TODO: - # we want to explicitly disallow - # cycles here, because the base - # storage engine does not support - # them + + # NOTE: + # this might not be enough, we might + # need to make it possible for the + # cycle checker to return the value + $self->check_for_cycle_in_collapse($attr, $value) + if ref $value; + if (defined $value && $attr->has_type_constraint) { - my $type_converter = $self->match_type($attr->type_constraint); + my $type_converter = $self->find_type_handler($attr->type_constraint); (defined $type_converter) || confess "Cannot convert " . $attr->type_constraint->name; $value = $type_converter->{collapse}->($value); @@ -57,72 +82,200 @@ sub collapse_attribute_value { sub expand_attribute_value { my ($self, $attr, $value) = @_; - # TODO: - # we need to check $value here to - # make sure that we do not have - # a cycle here. + + # NOTE: + # (see comment in method above ^^) + $self->check_for_cycle_in_expansion($attr, $value) + if ref $value; + if (defined $value && $attr->has_type_constraint) { - my $type_converter = $self->match_type($attr->type_constraint); + my $type_converter = $self->find_type_handler($attr->type_constraint); $value = $type_converter->{expand}->($value); } return $value; } +# NOTE: +# possibly these two methods will +# be used by a cycle supporting +# engine. However, I am not sure +# if I can make a cycle one work +# anyway. + +sub check_for_cycle_in_collapse { + my ($self, $attr, $value) = @_; + (!exists $self->seen->{$value}) + || confess "Basic Engine does not support cycles in class(" + . ($attr->associated_metaclass->name) . ").attr(" + . ($attr->name) . ") with $value"; + $self->seen->{$value} = undef; +} + +sub check_for_cycle_in_expansion { + my ($self, $attr, $value) = @_; + (!exists $self->seen->{$value}) + || confess "Basic Engine does not support cycles in class(" + . ($attr->associated_metaclass->name) . ").attr(" + . ($attr->name) . ") with $value"; + $self->seen->{$value} = undef; +} + # util methods ... sub map_attributes { my ($self, $method_name, @args) = @_; map { $self->$method_name($_, @args) + } grep { + # Skip our special skip attribute :) + !$_->isa('MooseX::Storage::Meta::Attribute::DoNotSerialize') } ($self->object || $self->class)->meta->compute_all_applicable_attributes; } +## ------------------------------------------------------------------ +## This is all the type handler stuff, it is in a state of flux +## right now, so this may change, or it may just continue to be +## improved upon. Comments and suggestions are welcomed. +## ------------------------------------------------------------------ + +# NOTE: +# these are needed by the +# ArrayRef and HashRef handlers +# below, so I need easy access +my %OBJECT_HANDLERS = ( + expand => sub { + my $data = shift; + (exists $data->{$CLASS_MARKER}) + || confess "Serialized item has no class marker"; + $data->{$CLASS_MARKER}->unpack($data); + }, + collapse => sub { + my $obj = shift; + ($obj->can('does') && $obj->does('MooseX::Storage::Basic')) + || confess "Bad object ($obj) does not do MooseX::Storage::Basic role"; + $obj->pack(); + }, +); + + my %TYPES = ( + # These are boring ones, so they use the identity function ... 'Int' => { expand => sub { shift }, collapse => sub { shift } }, 'Num' => { expand => sub { shift }, collapse => sub { shift } }, 'Str' => { expand => sub { shift }, collapse => sub { shift } }, - 'ArrayRef' => { expand => sub { shift }, collapse => sub { shift } }, - 'HashRef' => { expand => sub { shift }, collapse => sub { shift } }, - 'Object' => { + # These are the trickier ones, (see notes) + # NOTE: + # Because we are nice guys, we will check + # your ArrayRef and/or HashRef one level + # down and inflate any objects we find. + # But this is where it ends, it is too + # expensive to try and do this any more + # recursively, when it is probably not + # nessecary in most of the use cases. + # However, if you need more then this, subtype + # and add a custom handler. + 'ArrayRef' => { expand => sub { - my $data = shift; - (exists $data->{'__class__'}) - || confess "Serialized item has no class marker"; - $data->{'__class__'}->unpack($data); - }, + my $array = shift; + foreach my $i (0 .. $#{$array}) { + next unless ref($array->[$i]) eq 'HASH' + && exists $array->[$i]->{$CLASS_MARKER}; + $array->[$i] = $OBJECT_HANDLERS{expand}->($array->[$i]) + } + $array; + }, + collapse => sub { + my $array = shift; + # NOTE: + # we need to make a copy cause + # otherwise it will affect the + # other real version. + [ map { + blessed($_) + ? $OBJECT_HANDLERS{collapse}->($_) + : $_ + } @$array ] + } + }, + 'HashRef' => { + expand => sub { + my $hash = shift; + foreach my $k (keys %$hash) { + next unless ref($hash->{$k}) eq 'HASH' + && exists $hash->{$k}->{$CLASS_MARKER}; + $hash->{$k} = $OBJECT_HANDLERS{expand}->($hash->{$k}) + } + $hash; + }, collapse => sub { - my $obj = shift; - ($obj->can('does') && $obj->does('MooseX::Storage::Base')) - || confess "Bad object ($obj) does not do MooseX::Storage::Base role"; - $obj->pack(); - }, - } + my $hash = shift; + # NOTE: + # we need to make a copy cause + # otherwise it will affect the + # other real version. + +{ map { + blessed($hash->{$_}) + ? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_})) + : ($_ => $hash->{$_}) + } keys %$hash } + } + }, + 'Object' => \%OBJECT_HANDLERS, + # NOTE: + # The sanity of enabling this feature by + # default is very questionable. + # - SL + #'CodeRef' => { + # expand => sub {}, # use eval ... + # collapse => sub {}, # use B::Deparse ... + #} ); -sub match_type { +sub add_custom_type_handler { + my ($class, $type_name, %handlers) = @_; + (exists $handlers{expand} && exists $handlers{collapse}) + || confess "Custom type handlers need an expand *and* a collapse method"; + $TYPES{$type_name} = \%handlers; +} + +sub remove_custom_type_handler { + my ($class, $type_name) = @_; + delete $TYPES{$type_name} if exists $TYPES{$type_name}; +} + +sub find_type_handler { my ($self, $type_constraint) = @_; - return $TYPES{$type_constraint->name} if exists $TYPES{$type_constraint->name}; + + # this should handle most type usages + # since they they are usually just + # the standard set of built-ins + return $TYPES{$type_constraint->name} + if exists $TYPES{$type_constraint->name}; + + # the next possibility is they are + # a subtype of the built-in types, + # in which case this will DWIM in + # most cases. It is probably not + # 100% ideal though, but until I + # come up with a decent test case + # it will do for now. foreach my $type (keys %TYPES) { return $TYPES{$type} if $type_constraint->is_subtype_of($type); } - # TODO: - # from here we can expand this to support the following: - # - if it is subtype of Ref - # -- if it is a subtype of Object - # --- treat it like an object - # -- else - # --- treat it like any other Ref - # - else - # -- if it is a subtype of Num or Str - # --- treat it like Num or Str - # -- else - # --- pass it on - # this should cover 80% of all use cases - - # CHRIS: To cover the last 20% we need a way - # for people to extend this process. - + + # NOTE: + # the reason the above will work has to + # do with the fact that custom subtypes + # are mostly used for validation of + # the guts of a type, and not for some + # weird structural thing which would + # need to be accomidated by the serializer. + # Of course, mst or phaylon will probably + # do something to throw this assumption + # totally out the door ;) + # - SL + # NOTE: # if this method hasnt returned by now # then we have no been able to find a @@ -136,6 +289,102 @@ __END__ =pod +=head1 NAME + +MooseX::Storage::Engine - The meta-engine to handle collapsing and expanding objects + +=head1 DESCRIPTION + +No user serviceable parts inside. If you really want to know, read the source :) + +=head1 METHODS + +=head2 Accessors + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=back + +=head2 API + +=over 4 + +=item B + +=item B + +=back + +=head2 ... + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head2 Type Constraint Handlers + +=over 4 + +=item B + +=item B + +=item B + +=back + +=head2 Introspection + +=over 4 + +=item B + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Chris Prather Echris.prather@iinteractive.comE + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut +