sub import {
my $pkg = caller();
-
+
return if $pkg eq 'main';
-
+
($pkg->can('meta'))
|| confess "This package can only be used in Moose based classes";
-
- $pkg->meta->add_method('Storage' => __PACKAGE__->meta->find_method_by_name('_injected_storage_role_generator'));
+
+ $pkg->meta->add_method('Storage' => __PACKAGE__->meta->find_method_by_name('_injected_storage_role_generator'));
}
sub _injected_storage_role_generator {
my %params = @_;
-
+
if (exists $params{'base'}) {
- $params{'base'} = ('Base::' . $params{'base'});
+ $params{'base'} = ('Base::' . $params{'base'});
}
else {
- $params{'base'} = 'Basic';
+ $params{'base'} = 'Basic';
}
-
+
my @roles = (
('MooseX::Storage::' . $params{'base'}),
);
-
+
# NOTE:
- # you don't have to have a format
- # role, this just means you dont
+ # you don't have to have a format
+ # role, this just means you dont
# get anything other than pack/unpack
push @roles => 'MooseX::Storage::Format::' . $params{'format'}
if exists $params{'format'};
-
+
# NOTE:
- # many IO roles don't make sense unless
+ # many IO roles don't make sense unless
# you have also have a format role chosen
# too, the exception being StorableFile
if (exists $params{'io'}) {
# NOTE:
- # we dont need this code anymore, cause
- # the role composition will catch it for
+ # we dont need this code anymore, cause
+ # the role composition will catch it for
# us. This allows the StorableFile to work
#(exists $params{'format'})
# || confess "You must specify a format role in order to use an IO role";
push @roles => 'MooseX::Storage::IO::' . $params{'io'};
}
-
+
# Note:
# These traits alter the behaviour of the engine, the user can
# specify these per role-usage
push @roles, 'MooseX::Storage::Traits::'.$trait;
}
- for my $role ( @roles ) {
+ for my $role ( @roles ) {
Class::MOP::load_class($role) or die "Could not load role ($role)";
}
-
+
return @roles;
}
package Point;
use Moose;
use MooseX::Storage;
-
+
our $VERSION = '0.01';
-
+
with Storage('format' => 'JSON', 'io' => 'File');
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to pack/unpack an
+
+ ## methods to pack/unpack an
## object in perl data structures
-
+
# pack the class into a hash
$p->pack(); # { __CLASS__ => 'Point-0.01', x => 10, y => 10 }
-
+
# unpack the hash into a class
my $p2 = Point->unpack({ __CLASS__ => 'Point-0.01', x => 10, y => 10 });
- ## methods to freeze/thaw into
+ ## methods to freeze/thaw into
## a specified serialization format
## (in this case JSON)
-
+
# pack the class into a JSON string
$p->freeze(); # { "__CLASS__" : "Point-0.01", "x" : 10, "y" : 10 }
-
+
# unpack the JSON string into a class
- my $p2 = Point->thaw('{ "__CLASS__" : "Point-0.01", "x" : 10, "y" : 10 }');
+ my $p2 = Point->thaw('{ "__CLASS__" : "Point-0.01", "x" : 10, "y" : 10 }');
- ## methods to load/store a class
+ ## methods to load/store a class
## on the file system
-
+
$p->store('my_point.json');
-
+
my $p2 = Point->load('my_point.json');
=head1 DESCRIPTION
-MooseX::Storage is a serialization framework for Moose, it provides
+MooseX::Storage is a serialization framework for Moose, it provides
a very flexible and highly pluggable way to serialize Moose classes
to a number of different formats and styles.
=head2 Important Note
-This is still an early release of this module, so use with caution.
-It's outward facing serialization API should be considered stable,
+This is still an early release of this module, so use with caution.
+It's outward facing serialization API should be considered stable,
but I still reserve the right to make tweaks if I need too. Anything
-beyond the basic pack/unpack, freeze/thaw and load/store should not
+beyond the basic pack/unpack, freeze/thaw and load/store should not
be relied on.
=head2 Levels of Serialization
-There are 3 levels to the serialization, each of which builds upon
+There are 3 levels to the serialization, each of which builds upon
the other and each of which can be customized to the specific needs
of your class.
=item B<base>
-The first (base) level is C<pack> and C<unpack>. In this level the
-class is serialized into a Perl HASH reference, it is tagged with the
+The first (base) level is C<pack> and C<unpack>. In this level the
+class is serialized into a Perl HASH reference, it is tagged with the
class name and each instance attribute is stored. Very simple.
-This level is not optional, it is the bare minumum that
+This level is not optional, it is the bare minumum that
MooseX::Storage provides and all other levels build on top of this.
See L<Moosex::Storage::Basic> for the fundamental implementation and
=item B<format>
-The second (format) level is C<freeze> and C<thaw>. In this level the
-output of C<pack> is sent to C<freeze> or the output of C<thaw> is sent
-to C<unpack>. This levels primary role is to convert to and from the
-specific serialization format and Perl land.
+The second (format) level is C<freeze> and C<thaw>. In this level the
+output of C<pack> is sent to C<freeze> or the output of C<thaw> is sent
+to C<unpack>. This levels primary role is to convert to and from the
+specific serialization format and Perl land.
-This level is optional, if you don't want/need it, you don't have to
+This level is optional, if you don't want/need it, you don't have to
have it. You can just use C<pack>/C<unpack> instead.
=item B<io>
-The third (io) level is C<load> and C<store>. In this level we are reading
-and writing data to file/network/database/etc.
+The third (io) level is C<load> and C<store>. In this level we are reading
+and writing data to file/network/database/etc.
This level is also optional, in most cases it does require a C<format> role
to also be used, the expection being the C<StorableFile> role.
use MooseX::Storage;
with Storage( traits => [Trait1, Trait2,...] );
-
+
The following traits are currently bundled with C<MooseX::Storage>:
=over 4
=item OnlyWhenBuilt
-Only attributes that have been built (ie, where the predicate returns
+Only attributes that have been built (ie, where the predicate returns
'true') will be serialized. This avoids any potentially expensive computations.
See L<MooseX::Storage::Traits::OnlyWhenBuilt> for details.
=head2 How we serialize
-There are always limits to any serialization framework, there are just
-some things which are really difficult to serialize properly and some
+There are always limits to any serialization framework, there are just
+some things which are really difficult to serialize properly and some
things which cannot be serialized at all.
=head2 What can be serialized?
-Currently only numbers, string, ARRAY refs, HASH refs and other
-MooseX::Storage enabled objects are supported.
+Currently only numbers, string, ARRAY refs, HASH refs and other
+MooseX::Storage enabled objects are supported.
-With Array and Hash references the first level down is inspected and
-any objects found are serialized/deserialized for you. We do not do
-this recusively by default, however this feature may become an
+With Array and Hash references the first level down is inspected and
+any objects found are serialized/deserialized for you. We do not do
+this recusively by default, however this feature may become an
option eventually.
-The specific serialize/deserialize routine is determined by the
-Moose type constraint a specific attribute has. In most cases subtypes
-of the supported types are handled correctly, and there is a facility
+The specific serialize/deserialize routine is determined by the
+Moose type constraint a specific attribute has. In most cases subtypes
+of the supported types are handled correctly, and there is a facility
for adding handlers for custom types as well. This will get documented
eventually, but it is currently still in development.
=head2 What can not be serialized?
-We do not support CODE references yet, but this support might be added
-in using B::Deparse or some other deep magic.
+We do not support CODE references yet, but this support might be added
+in using B::Deparse or some other deep magic.
-Scalar refs are not supported, mostly because there is no way to know
-if the value being referenced will be there when the object is inflated.
-I highly doubt will be ever support this in a general sense, but it
+Scalar refs are not supported, mostly because there is no way to know
+if the value being referenced will be there when the object is inflated.
+I highly doubt will be ever support this in a general sense, but it
would be possible to add this yourself for a small specific case.
-Circular references are specifically disallowed, however if you break
+Circular references are specifically disallowed, however if you break
the cycles yourself then re-assemble them later you can get around this.
-The reason we disallow circular refs is because they are not always supported
-in all formats we use, and they tend to be very tricky to do for all
-possible cases. It is almost always something you want to have tight control
+The reason we disallow circular refs is because they are not always supported
+in all formats we use, and they tend to be very tricky to do for all
+possible cases. It is almost always something you want to have tight control
over anyway.
=head1 CAVEAT
This is B<not> a persistence framework, changes to your object after
-you load or store it will not be reflected in the stored class.
+you load or store it will not be reflected in the stored class.
=head1 EXPORTS
=item B<Storage (%options)>
-This module will export the C<Storage> method will can be used to
-load a specific set of MooseX::Storage roles to implement a specific
-combination of features. It is meant to make things easier, but it
-is by no means the only way. You can still compose your roles by
+This module will export the C<Storage> method will can be used to
+load a specific set of MooseX::Storage roles to implement a specific
+combination of features. It is meant to make things easier, but it
+is by no means the only way. You can still compose your roles by
hand if you like.
=back
=head1 TODO
-This module needs docs and probably a Cookbook of some kind as well.
+This module needs docs and probably a Cookbook of some kind as well.
This is an early release, so that is my excuse for now :)
-For the time being, please read the tests and feel free to email me
-if you have any questions. This module can also be discussed on IRC
+For the time being, please read the tests and feel free to email me
+if you have any questions. This module can also be discussed on IRC
in the #moose channel on irc.perl.org.
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
my $collapsed = $self->$orig( @args );
$collapsed->{$DIGEST_MARKER} = $self->_digest_packed($collapsed, @args);
-
+
return $collapsed;
};
# check checksum on data
my $old_checksum = delete $data->{$DIGEST_MARKER};
-
+
my $checksum = $class->_digest_packed($data, @args);
($checksum eq $old_checksum)
- || confess "Bad Checksum got=($checksum) expected=($old_checksum)";
+ || confess "Bad Checksum got=($checksum) expected=($old_checksum)";
$class->$orig( $data, @args );
};
local $Data::Dumper::Deparse = 0; # FIXME?
my $str = Data::Dumper::Dumper($collapsed);
# NOTE:
- # Canonicalize numbers to strings even if it
- # mangles numbers inside strings. It really
+ # Canonicalize numbers to strings even if it
+ # mangles numbers inside strings. It really
# does not matter since its just the checksum
# anyway.
# - YK/SL
- $str =~ s/(?<! ['"] ) \b (\d+) \b (?! ['"] )/'$1'/gx;
+ $str =~ s/(?<! ['"] ) \b (\d+) \b (?! ['"] )/'$1'/gx;
$d->add( $str );
}
sub _digest_object {
my ( $self, %options ) = @_;
my $digest_opts = $options{digest};
-
- $digest_opts = [ $digest_opts ]
+
+ $digest_opts = [ $digest_opts ]
if !ref($digest_opts) or ref($digest_opts) ne 'ARRAY';
-
+
my ( $d, @args ) = @$digest_opts;
if ( ref $d ) {
if ( $d->can("clone") ) {
return $d->clone;
- }
+ }
elsif ( $d->can("reset") ) {
$d->reset;
return $d;
- }
+ }
else {
die "Can't clone or reset digest object: $d";
}
- }
+ }
else {
return Digest->new($d || "SHA1", @args);
}
=head1 DESCRIPTION
-This is an early implementation of a more secure Storage role,
-which does integrity checks on the data. It is still being
-developed so I recommend using it with caution.
+This is an early implementation of a more secure Storage role,
+which does integrity checks on the data. It is still being
+developed so I recommend using it with caution.
-Any thoughts, ideas or suggestions on improving our technique
+Any thoughts, ideas or suggestions on improving our technique
are very welcome.
=head1 METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
sub unpack {
my ($class, $data, %args) = @_;
my $e = $class->_storage_get_engine_class(%args)->new(class => $class);
-
- $class->_storage_construct_instance(
- $e->expand_object($data, %args),
- \%args
+
+ $class->_storage_construct_instance(
+ $e->expand_object($data, %args),
+ \%args
);
}
return $default
unless (
- exists $args{engine_traits}
+ exists $args{engine_traits}
&& ref($args{engine_traits}) eq 'ARRAY'
&& scalar(@{$args{engine_traits}})
);
-
+
my @roles = map { sprintf("%s::Trait::%s", $default, $_) }
@{$args{engine_traits}};
-
+
Moose::Meta::Class->create_anon_class(
superclasses => [$default],
roles => [ @roles ],
sub _storage_construct_instance {
my ($class, $args, $opts) = @_;
my %i = defined $opts->{'inject'} ? %{ $opts->{'inject'} } : ();
-
+
$class->new( %$args, %i );
}
package Point;
use Moose;
use MooseX::Storage;
-
+
our $VERSION = '0.01';
-
+
with Storage;
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to pack/unpack an
+
+ ## methods to pack/unpack an
## object in perl data structures
-
+
# pack the class into a hash
$p->pack(); # { __CLASS__ => 'Point-0.01', x => 10, y => 10 }
-
+
# unpack the hash into a class
my $p2 = Point->unpack({ __CLASS__ => 'Point-0.01', x => 10, y => 10 });
-
+
# unpack the hash, with insertion of paramaters
my $p3 = Point->unpack( $p->pack, inject => { x => 11 } );
=head1 DESCRIPTION
-This is the most basic form of serialization. This is used by default
+This is the most basic form of serialization. This is used by default
but the exported C<Storage> function.
=head1 METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
=back
-B<NOTE:> The B<StorableFile> I/O option is not supported,
-this is because it does not mix well with options who also
+B<NOTE:> The B<StorableFile> I/O option is not supported,
+this is because it does not mix well with options who also
have a C<thaw> and C<freeze> methods like this. It is possible
-to probably work around this issue, but I don't currently
+to probably work around this issue, but I don't currently
have the need for it. If you need this supported, talk to me
-and I will see what I can do.
+and I will see what I can do.
=head1 METHODS
our $VERSION = '0.18';
our $AUTHORITY = 'cpan:STEVAN';
-# the class marker when
-# serializing an object.
+# the class marker when
+# serializing an object.
our $CLASS_MARKER = '__CLASS__';
has 'storage' => (
$self->seen->{refaddr $self->object} = undef;
$self->map_attributes('collapse_attribute', \%options);
- $self->storage->{$CLASS_MARKER} = $self->object->meta->identifier;
+ $self->storage->{$CLASS_MARKER} = $self->object->meta->identifier;
return $self->storage;
}
sub expand_object {
my ($self, $data, %options) = @_;
-
+
$options{check_version} = 1 unless exists $options{check_version};
- $options{check_authority} = 1 unless exists $options{check_authority};
+ $options{check_authority} = 1 unless exists $options{check_authority};
# NOTE:
# mark the root object as seen ...
- $self->seen->{refaddr $data} = undef;
-
+ $self->seen->{refaddr $data} = undef;
+
$self->map_attributes('expand_attribute', $data, \%options);
- return $self->storage;
+ return $self->storage;
}
## this is the internal API ...
if( ref $value and not(
$options->{disable_cycle_check} or
$self->class->does('MooseX::Storage::Traits::DisableCycleDetection')
- )) {
+ )) {
$self->check_for_cycle_in_collapse($attr, $value)
}
-
+
if (defined $value && $attr->has_type_constraint) {
my $type_converter = $self->find_type_handler($attr->type_constraint);
$value = $type_converter->{expand}->($value, $options);
}
# 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
+# 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->{refaddr $value})
- || confess "Basic Engine does not support cycles in class("
+ || confess "Basic Engine does not support cycles in class("
. ($attr->associated_class->name) . ").attr("
. ($attr->name) . ") with $value";
$self->seen->{refaddr $value} = undef;
sub check_for_cycle_in_expansion {
my ($self, $attr, $value) = @_;
(!exists $self->seen->{refaddr $value})
- || confess "Basic Engine does not support cycles in class("
+ || confess "Basic Engine does not support cycles in class("
. ($attr->associated_class->name) . ").attr("
. ($attr->name) . ") with $value";
$self->seen->{refaddr $value} = undef;
sub map_attributes {
my ($self, $method_name, @args) = @_;
- map {
- $self->$method_name($_, @args)
+ map {
+ $self->$method_name($_, @args)
} grep {
# Skip our special skip attribute :)
- !$_->does('MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize')
+ !$_->does('MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize')
} ($self->object || $self->class)->meta->get_all_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
+## 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
+# these are needed by the
# ArrayRef and HashRef handlers
-# below, so I need easy access
+# below, so I need easy access
my %OBJECT_HANDLERS = (
expand => sub {
- my ($data, $options) = @_;
+ my ($data, $options) = @_;
(exists $data->{$CLASS_MARKER})
|| confess "Serialized item has no class marker";
# 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 $@;
-
+ confess "Class ($class) is not loaded, cannot unpack" if $@;
+
if ($options->{check_version}) {
my $meta_version = $meta->version;
- if (defined $meta_version && $version) {
+ if (defined $meta_version && $version) {
if ($options->{check_version} eq 'allow_less_than') {
($meta_version <= $version)
- || confess "Class ($class) versions is not less than currently available."
- . " got=($version) available=($meta_version)";
+ || confess "Class ($class) versions is not less than currently available."
+ . " got=($version) available=($meta_version)";
}
elsif ($options->{check_version} eq 'allow_greater_than') {
($meta->version >= $version)
- || confess "Class ($class) versions is not greater than currently available."
- . " got=($version) available=($meta_version)";
- }
+ || confess "Class ($class) versions is not greater than currently available."
+ . " got=($version) available=($meta_version)";
+ }
else {
($meta->version == $version)
- || confess "Class ($class) versions don't match."
+ || confess "Class ($class) versions don't match."
. " got=($version) available=($meta_version)";
}
}
}
-
+
if ($options->{check_authority}) {
my $meta_authority = $meta->authority;
($meta->authority eq $authority)
- || confess "Class ($class) authorities don't match."
+ || confess "Class ($class) authorities don't match."
. " got=($authority) available=($meta_authority)"
- if defined $meta_authority && defined $authority;
+ if defined $meta_authority && defined $authority;
}
-
+
# all is well ...
$class->unpack($data, %$options);
},
my %TYPES = (
# NOTE:
- # we need to make sure that we properly numify the numbers
- # before and after them being futzed with, because some of
+ # we need to make sure that we properly numify the numbers
+ # before and after them being futzed with, because some of
# the JSON engines are stupid/annoying/frustrating
'Int' => { expand => sub { $_[0] + 0 }, collapse => sub { $_[0] + 0 } },
'Num' => { expand => sub { $_[0] + 0 }, collapse => sub { $_[0] + 0 } },
- # These are boring ones, so they use the identity function ...
+ # These are boring ones, so they use the identity function ...
'Str' => { expand => sub { shift }, collapse => sub { shift } },
'Bool' => { expand => sub { shift }, collapse => sub { shift } },
# 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.
+ # 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
+ # 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' => {
+ # However, if you need more then this, subtype
+ # and add a custom handler.
+ 'ArrayRef' => {
expand => sub {
my ( $array, @args ) = @_;
foreach my $i (0 .. $#{$array}) {
- next unless ref($array->[$i]) eq 'HASH'
+ next unless ref($array->[$i]) eq 'HASH'
&& exists $array->[$i]->{$CLASS_MARKER};
$array->[$i] = $OBJECT_HANDLERS{expand}->($array->[$i], @args);
}
$array;
- },
+ },
collapse => sub {
my ( $array, @args ) = @_;
- # NOTE:
+ # NOTE:
# we need to make a copy cause
- # otherwise it will affect the
+ # otherwise it will affect the
# other real version.
[ map {
blessed($_)
? $OBJECT_HANDLERS{collapse}->($_, @args)
: $_
- } @$array ]
- }
+ } @$array ]
+ }
},
- 'HashRef' => {
+ 'HashRef' => {
expand => sub {
my ( $hash, @args ) = @_;
foreach my $k (keys %$hash) {
- next unless ref($hash->{$k}) eq 'HASH'
+ next unless ref($hash->{$k}) eq 'HASH'
&& exists $hash->{$k}->{$CLASS_MARKER};
$hash->{$k} = $OBJECT_HANDLERS{expand}->($hash->{$k}, @args);
}
- $hash;
- },
+ $hash;
+ },
collapse => sub {
my ( $hash, @args ) = @_;
- # NOTE:
+ # NOTE:
# we need to make a copy cause
- # otherwise it will affect the
+ # otherwise it will affect the
# other real version.
+{ map {
blessed($hash->{$_})
? ($_ => $OBJECT_HANDLERS{collapse}->($hash->{$_}, @args))
: ($_ => $hash->{$_})
- } keys %$hash }
- }
+ } keys %$hash }
+ }
},
'Object' => \%OBJECT_HANDLERS,
# NOTE:
- # The sanity of enabling this feature by
+ # The sanity of enabling this feature by
# default is very questionable.
# - SL
#'CodeRef' => {
# expand => sub {}, # use eval ...
- # collapse => sub {}, # use B::Deparse ...
- #}
+ # collapse => sub {}, # use B::Deparse ...
+ #}
);
sub add_custom_type_handler {
sub find_type_handler {
my ($self, $type_constraint) = @_;
-
+
# check if the type is a Maybe and
# if its parent is not parameterized.
# If both is true recurse this method
and not $type_constraint->parent->can('type_parameter');
# this should handle most type usages
- # since they they are usually just
+ # since they they are usually just
# the standard set of built-ins
- return $TYPES{$type_constraint->name}
+ 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
+
+ # 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}
+ return $TYPES{$type}
if $type_constraint->is_subtype_of($type);
}
-
+
# NOTE:
- # the reason the above will work has to
+ # the reason the above will work has to
# do with the fact that custom subtypes
- # are mostly used for validation of
+ # are mostly used for validation of
# the guts of a type, and not for some
- # weird structural thing which would
+ # 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
+ # 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
- # type constraint handler to match
- confess "Cannot handle type constraint (" . $type_constraint->name . ")";
+ # then we have no been able to find a
+ # type constraint handler to match
+ confess "Cannot handle type constraint (" . $type_constraint->name . ")";
}
sub find_type_handler_for {
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
package Point;
use Moose;
use MooseX::Storage;
-
+
with Storage('format' => 'JSON');
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to freeze/thaw into
+
+ ## methods to freeze/thaw into
## a specified serialization format
## (in this case JSON)
-
+
# pack the class into a JSON string
$p->freeze(); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 }
-
+
# unpack the JSON string into a class
- my $p2 = Point->thaw('{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }');
+ my $p2 = Point->thaw('{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }');
=head1 METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
package Point;
use Moose;
use MooseX::Storage;
-
+
with Storage('format' => 'Storable');
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to freeze/thaw into
+
+ ## methods to freeze/thaw into
## a specified serialization format
-
+
# pack the class with Storable
- my $storable_data = $p->freeze();
-
+ my $storable_data = $p->freeze();
+
# unpack the storable data into the class
- my $p2 = Point->thaw($storable_data);
+ my $p2 = Point->thaw($storable_data);
=head1 DESCRIPTION
-This module will C<thaw> and C<freeze> Moose classes using Storable. It
-uses C<Storable::nfreeze> by default so that it can be easily used
-in IPC scenarios across machines or just locally.
+This module will C<thaw> and C<freeze> Moose classes using Storable. It
+uses C<Storable::nfreeze> by default so that it can be easily used
+in IPC scenarios across machines or just locally.
-One important thing to note is that this module does not mix well
-with the IO modules. The structures that C<freeze> and C<thaw> deal with
-are Storable's memory representation, and (as far as I know) that
-is not easily just written onto a file. If you want file based
-serialization with Storable, the please look at the
+One important thing to note is that this module does not mix well
+with the IO modules. The structures that C<freeze> and C<thaw> deal with
+are Storable's memory representation, and (as far as I know) that
+is not easily just written onto a file. If you want file based
+serialization with Storable, the please look at the
L<MooseX::Storage::IO::StorableFile> role instead.
=head1 METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
# -dcp
use Best [
- [ qw[YAML::Syck YAML] ],
+ [ qw[YAML::Syck YAML] ],
[ qw[Load Dump] ]
];
package Point;
use Moose;
use MooseX::Storage;
-
+
with Storage('format' => 'YAML');
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to freeze/thaw into
+
+ ## methods to freeze/thaw into
## a specified serialization format
## (in this case YAML)
-
+
# pack the class into a YAML string
- $p->freeze();
+ $p->freeze();
# ----
- # __CLASS__: "Point"
+ # __CLASS__: "Point"
# x: 10
- # y: 10
-
+ # y: 10
+
# unpack the JSON string into a class
- my $p2 = Point->thaw(<<YAML);
+ my $p2 = Point->thaw(<<YAML);
----
- __CLASS__: "Point"
+ __CLASS__: "Point"
x: 10
y: 10
YAML
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
package Point;
use Moose;
use MooseX::Storage;
-
+
with Storage('format' => 'JSON', 'io' => 'AtomicFile');
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to load/store a class
+
+ ## methods to load/store a class
## on the file system
-
+
$p->store('my_point.json');
-
+
my $p2 = Point->load('my_point.json');
=head1 METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
package Point;
use Moose;
use MooseX::Storage;
-
+
with Storage('format' => 'JSON', 'io' => 'File');
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to load/store a class
+
+ ## methods to load/store a class
## on the file system
-
+
$p->store('my_point.json');
-
+
my $p2 = Point->load('my_point.json');
=head1 METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
my ( $class, $filename, @args ) = @_;
# try thawing
return $class->thaw( Storable::retrieve($filename), @args )
- if $class->can('thaw');
+ if $class->can('thaw');
# otherwise just unpack
$class->unpack( Storable::retrieve($filename), @args );
}
sub store {
my ( $self, $filename, @args ) = @_;
- Storable::nstore(
+ Storable::nstore(
# try freezing, otherwise just pack
- ($self->can('freeze') ? $self->freeze(@args) : $self->pack(@args)),
- $filename
+ ($self->can('freeze') ? $self->freeze(@args) : $self->pack(@args)),
+ $filename
);
}
package Point;
use Moose;
use MooseX::Storage;
-
+
with Storage('io' => 'StorableFile');
-
+
has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');
-
+
1;
-
+
my $p = Point->new(x => 10, y => 10);
-
- ## methods to load/store a class
+
+ ## methods to load/store a class
## on the file system
-
+
$p->store('my_point');
-
+
my $p2 = Point->load('my_point');
=head1 DESCRIPTION
-This module will C<load> and C<store> Moose classes using Storable. It
-uses C<Storable::nstore> by default so that it can be easily used
-across machines or just locally.
+This module will C<load> and C<store> Moose classes using Storable. It
+uses C<Storable::nstore> by default so that it can be easily used
+across machines or just locally.
-One important thing to note is that this module does not mix well
-with the other Format modules. Since Storable serialized perl data
-structures in it's own format, those roles are lagely unnecessary.
+One important thing to note is that this module does not mix well
+with the other Format modules. Since Storable serialized perl data
+structures in it's own format, those roles are lagely unnecessary.
-However, there is always the possibility that having a set of
-C<freeze/thaw> hooks can be useful, so because of that this module
+However, there is always the possibility that having a set of
+C<freeze/thaw> hooks can be useful, so because of that this module
will attempt to use C<freeze> or C<thaw> if that method is available.
-Of course, you should be careful when doing this as it could lead to
+Of course, you should be careful when doing this as it could lead to
all sorts of hairy issues. But you have been warned.
=head1 METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
use Moose;
use MooseX::Storage;
with Storage( traits => ['DisableCycleDetection'] );
-
+
has 'x' => ( is => 'rw', isa => 'HashRef' );
has 'y' => ( is => 'rw', isa => 'HashRef' );
my $ref = {};
my $double = Double->new( 'x' => $ref, 'y' => $ref );
-
+
$double->pack;
-
-
+
=head1 DESCRIPTION
C<MooseX::Storage> implements a primitive check for circular references.
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
it under the same terms as Perl itself.
=cut
+
{ package Point;
use Moose;
use MooseX::Storage;
-
+
with Storage( traits => [qw|OnlyWhenBuilt|] );
-
+
has 'x' => (is => 'rw', lazy_build => 1 );
has 'y' => (is => 'rw', lazy_build => 1 );
has 'z' => (is => 'rw', builder => '_build_z' );
-
-
+
sub _build_x { 3 }
sub _build_y { expensive_computation() }
sub _build_z { 3 }
-
+
}
-
+
my $p = Point->new( 'x' => 4 );
-
+
# the result of ->pack will contain:
# { x => 4, z => 3 }
$p->pack;
-
+
=head1 DESCRIPTION
-Sometimes you don't want a particular attribute to be part of the
+Sometimes you don't want a particular attribute to be part of the
serialization if it has not been built yet. If you invoke C<Storage()>
as outlined in the C<Synopsis>, only attributes that have been built
(ie, where the predicate returns 'true') will be serialized.
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
sub peek {
my ($class, $data, %options) = @_;
-
+
if (exists $options{'format'}) {
-
+
my $inflater = $class->can('_inflate_' . lc($options{'format'}));
-
+
(defined $inflater)
|| confess "No inflater found for " . $options{'format'};
-
+
$data = $class->$inflater($data);
}
(ref($data) && ref($data) eq 'HASH' && !blessed($data))
|| confess "The data has to be a HASH reference, but not blessed";
-
+
$options{'key'} ||= $MooseX::Storage::Engine::CLASS_MARKER;
-
+
return $data->{$options{'key'}};
}
my ($class, $json) = @_;
eval { require JSON::Any; JSON::Any->import };
- confess "Could not load JSON module because : $@" if $@;
-
- utf8::encode($json) if utf8::is_utf8($json);
-
+ confess "Could not load JSON module because : $@" if $@;
+
+ utf8::encode($json) if utf8::is_utf8($json);
+
my $data = eval { JSON::Any->jsonToObj($json) };
if ($@) {
confess "There was an error when attempting to peek at JSON: $@";
}
-
+
return $data;
}
sub _inflate_yaml {
my ($class, $yaml) = @_;
-
- require Best;
+
+ require Best;
eval { Best->import([[ qw[YAML::Syck YAML] ]]) };
- confess "Could not load YAML module because : $@" if $@;
-
+ confess "Could not load YAML module because : $@" if $@;
+
my $inflater = Best->which('YAML::Syck')->can('Load');
-
+
(defined $inflater)
|| confess "Could not load the YAML inflator";
-
+
my $data = eval { $inflater->($yaml) };
if ($@) {
confess "There was an error when attempting to peek at YAML : $@";
=head1 DESCRIPTION
-This module provides a set of tools, some sharp and focused,
+This module provides a set of tools, some sharp and focused,
others more blunt and crude. But no matter what, they are useful
-bits to have around when dealing with MooseX::Storage code.
+bits to have around when dealing with MooseX::Storage code.
=head1 METHODS
-All the methods in this package are class methods and should
-be called appropriately.
+All the methods in this package are class methods and should
+be called appropriately.
=over 4
=item B<peek ($data, %options)>
-This method will help you to verify that the serialized class you
-have gotten is what you expect it to be before you actually
+This method will help you to verify that the serialized class you
+have gotten is what you expect it to be before you actually
unfreeze/unpack it.
The C<$data> can be either a perl HASH ref or some kind of serialized
=item I<key>
-The default is to try and extract the class name, but if you want to check
+The default is to try and extract the class name, but if you want to check
another key in the data, you can set this option. It will return the value
found in the key for you.
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
projects / gitmo/MooseX-Storage.git / commitdiff