foo

[gitmo/MooseX-Storage.git] / lib / MooseX / Storage / Engine.pm

diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm
index dd47f8c..80f0f94 100644 (file)
--- a/lib/MooseX/Storage/Engine.pm
+++ b/lib/MooseX/Storage/Engine.pm
@@ -2,7 +2,7 @@
 package MooseX::Storage::Engine;
 use Moose;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 # the class marker when 
 # serializing an object. 
@@ -33,7 +33,7 @@ sub collapse_object {
        $self->seen->{$self->object} = undef;
        
     $self->map_attributes('collapse_attribute');
-    $self->storage->{$CLASS_MARKER} = $self->object->meta->name;    
+    $self->storage->{$CLASS_MARKER} = $self->object->meta->identifier;    
        return $self->storage;
 }
 
@@ -68,7 +68,7 @@ sub collapse_attribute_value {
        # 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($value) 
+    $self->check_for_cycle_in_collapse($attr, $value) 
         if ref $value;
        
     if (defined $value && $attr->has_type_constraint) {
@@ -85,7 +85,7 @@ sub expand_attribute_value {
 
        # NOTE:
        # (see comment in method above ^^)
-    $self->check_for_cycle_in_expansion($value) 
+    $self->check_for_cycle_in_expansion($attr, $value) 
         if ref $value;    
     
     if (defined $value && $attr->has_type_constraint) {
@@ -103,16 +103,20 @@ sub expand_attribute_value {
 # anyway.
 
 sub check_for_cycle_in_collapse {
-    my ($self, $value) = @_;
+    my ($self, $attr, $value) = @_;
     (!exists $self->seen->{$value})
-        || confess "Basic Engine does not support cycles";
+        || confess "Basic Engine does not support cycles in class(" 
+                 . ($attr->associated_class->name) . ").attr("
+                 . ($attr->name) . ") with $value";
     $self->seen->{$value} = undef;
 }
 
 sub check_for_cycle_in_expansion {
-    my ($self, $value) = @_;
+    my ($self, $attr, $value) = @_;
     (!exists $self->seen->{$value})
-        || confess "Basic Engine does not support cycles";
+    || confess "Basic Engine does not support cycles in class(" 
+             . ($attr->associated_class->name) . ").attr("
+             . ($attr->name) . ") with $value";
     $self->seen->{$value} = undef;
 }
 
@@ -143,7 +147,20 @@ my %OBJECT_HANDLERS = (
         my $data = shift;   
         (exists $data->{$CLASS_MARKER})
             || confess "Serialized item has no class marker";
-        $data->{$CLASS_MARKER}->unpack($data);
+        # check the class more thoroughly here ...
+        my ($class, $version, $authority) = (split '-' => $data->{$CLASS_MARKER});
+        my $meta = eval { $class->meta };
+        confess "Class ($class) is not loaded, cannot unpack" if $@;
+        ($meta->version == $version)
+            || confess "Class ($class) versions don't match." 
+                     . " got=($version) available=(" . ($meta->version || '') . ")"
+            if defined $version;
+        ($meta->authority eq $authority)
+            || confess "Class ($class) authorities don't match." 
+                     . " got=($authority) available=(" . ($meta->authority || '') . ")"
+            if defined $authority;            
+        # all is well ...
+        $class->unpack($data);
     },
     collapse => sub {
         my $obj = shift;
@@ -287,12 +304,12 @@ __END__
 
 =head1 NAME
 
-MooseX::Storage::Engine
-
-=head1 SYNOPSIS
+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