Revision history for MooseX-Storage
+0.10
+ ~~ updated copyright information ~~
+
+ * MooseX::Storage::Deferred
+ - added this role, which allows you to wait until
+ you actually call a method to determine what
+ formatter and/or IO engine you want to use
+ - added tests for this
+
0.09 Tue. Oct. 23, 2007
* MooseX::Storage::Util
- added support to deal with utf8 strings correctly
-MooseX-Storage version 0.09
+MooseX-Storage version 0.10
INSTALLATION
COPYRIGHT AND LICENCE
-Copyright (C) 2007, Infinity Interactive
+Copyright (C) 2007-2008 Infinity Interactive
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
use MooseX::Storage::Meta::Attribute::DoNotSerialize;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
our $AUTHORITY = 'cpan:STEVAN';
sub import {
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
--- /dev/null
+package MooseX::Storage::Deferred;
+use Moose::Role;
+
+our $VERSION = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'MooseX::Storage::Basic';
+
+sub thaw {
+ my ( $class, $packed, $type, @args ) = @_;
+
+ (exists $type->{format})
+ || confess "You must specify a format type to thaw from";
+
+ my $class_to_load = 'MooseX::Storage::Format::' . $type->{format};
+ Class::MOP::load_class($class_to_load);
+
+ my $method_to_call = $class_to_load . '::thaw';
+
+ $class->$method_to_call($packed, @args);
+}
+
+sub freeze {
+ my ( $self, $type, @args ) = @_;
+
+ (exists $type->{format})
+ || confess "You must specify a format type to freeze into";
+
+ my $class_to_load = 'MooseX::Storage::Format::' . $type->{format};
+ Class::MOP::load_class($class_to_load);
+
+ my $method_to_call = $class_to_load . '::freeze';
+
+ $self->$method_to_call(@args);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Storage::Deferred - A role for undecisive programmers
+
+=head1 SYNOPSIS
+
+ package Point;
+ use Moose;
+ use MooseX::Storage;
+
+ our $VERSION = '0.01';
+
+ with 'MooseX::Storage::Deferred';
+
+ 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
+ ## a specified serialization format
+ ## (in this case JSON)
+
+ # pack the class into a JSON string
+ $p->freeze({ format => 'JSON' }); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 }
+
+ # unpack the JSON string into a class
+ my $p2 = Point->thaw(
+ '{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }',
+ { format => 'JSON' }
+ );
+
+=head1 DESCRIPTION
+
+This role is designed for those times when you need to
+serialize into many different formats or I/O options.
+It basically allows you to choose the format and IO
+options only when you actually use them (see the
+SYNOPSIS for more info)
+
+=head1 METHODS
+
+=over 4
+
+=item B<freeze ($type_desc)>
+
+=item B<thaw ($data, $type_desc)>
+
+=back
+
+=head2 Introspection
+
+=over 4
+
+=item B<meta>
+
+=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
+
+Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
--- /dev/null
+#!/usr/bin/perl
+$|++;
+use strict;
+use warnings;
+
+use Test::More tests => 33;
+use Storable;
+use Test::JSON;
+use Test::YAML::Valid;
+
+BEGIN {
+ $ENV{JSON_ANY_ORDER} = qw(JSON);
+ use_ok('MooseX::Storage');
+}
+
+{
+
+ package Foo;
+ use Moose;
+ use MooseX::Storage;
+
+ with 'MooseX::Storage::Deferred';
+
+ has 'number' => ( is => 'ro', isa => 'Int' );
+ has 'string' => ( is => 'ro', isa => 'Str' );
+ has 'float' => ( is => 'ro', isa => 'Num' );
+ has 'array' => ( is => 'ro', isa => 'ArrayRef' );
+ has 'hash' => ( is => 'ro', isa => 'HashRef' );
+ has 'object' => ( is => 'ro', isa => 'Object' );
+}
+
+{
+ my $foo = Foo->new(
+ number => 10,
+ string => 'foo',
+ float => 10.5,
+ array => [ 1 .. 10 ],
+ hash => { map { $_ => undef } ( 1 .. 10 ) },
+ object => Foo->new( number => 2 ),
+ );
+ isa_ok( $foo, 'Foo' );
+
+ my $json = $foo->freeze({ 'format' => 'JSON' });
+
+ is_valid_json($json, '.. this is valid JSON');
+
+ is_json(
+ $json,
+'{"array":[1,2,3,4,5,6,7,8,9,10],"hash":{"6":null,"3":null,"7":null,"9":null,"2":null,"8":null,"1":null,"4":null,"10":null,"5":null},"float":10.5,"object":{"number":2,"__CLASS__":"Foo"},"number":10,"__CLASS__":"Foo","string":"foo"}',
+ '... got the right JSON'
+ );
+}
+
+{
+ my $foo = Foo->thaw(
+ '{"array":[1,2,3,4,5,6,7,8,9,10],"hash":{"6":null,"3":null,"7":null,"9":null,"2":null,"8":null,"1":null,"4":null,"10":null,"5":null},"float":10.5,"object":{"number":2,"__CLASS__":"Foo"},"number":10,"__CLASS__":"Foo","string":"foo"}',
+ { 'format' => 'JSON' }
+ );
+ isa_ok( $foo, 'Foo' );
+
+ is( $foo->number, 10, '... got the right number' );
+ is( $foo->string, 'foo', '... got the right string' );
+ is( $foo->float, 10.5, '... got the right float' );
+ is_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
+ is_deeply(
+ $foo->hash,
+ { map { $_ => undef } ( 1 .. 10 ) },
+ '... got the right hash'
+ );
+
+ isa_ok( $foo->object, 'Foo' );
+ is( $foo->object->number, 2,
+ '... got the right number (in the embedded object)' );
+}
+
+{
+ my $foo = Foo->new(
+ number => 10,
+ string => 'foo',
+ float => 10.5,
+ array => [ 1 .. 10 ],
+ hash => { map { $_ => undef } ( 1 .. 10 ) },
+ object => Foo->new( number => 2 ),
+ );
+ isa_ok( $foo, 'Foo' );
+
+ my $stored = $foo->freeze({ 'format' => 'Storable' });
+
+ my $struct = Storable::thaw($stored);
+ is_deeply(
+ $struct,
+ {
+ '__CLASS__' => 'Foo',
+ 'float' => 10.5,
+ 'number' => 10,
+ 'string' => 'foo',
+ 'array' => [ 1 .. 10],
+ 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'object' => {
+ '__CLASS__' => 'Foo',
+ 'number' => 2
+ },
+ },
+ '... got the data struct we expected'
+ );
+}
+
+{
+ my $stored = Storable::nfreeze({
+ '__CLASS__' => 'Foo',
+ 'float' => 10.5,
+ 'number' => 10,
+ 'string' => 'foo',
+ 'array' => [ 1 .. 10],
+ 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'object' => {
+ '__CLASS__' => 'Foo',
+ 'number' => 2
+ },
+ });
+
+ my $foo = Foo->thaw($stored, { 'format' => 'Storable' });
+ isa_ok( $foo, 'Foo' );
+
+ is( $foo->number, 10, '... got the right number' );
+ is( $foo->string, 'foo', '... got the right string' );
+ is( $foo->float, 10.5, '... got the right float' );
+ is_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
+ is_deeply(
+ $foo->hash,
+ { map { $_ => undef } ( 1 .. 10 ) },
+ '... got the right hash'
+ );
+
+ isa_ok( $foo->object, 'Foo' );
+ is( $foo->object->number, 2,
+ '... got the right number (in the embedded object)' );
+}
+
+{
+ my $foo = Foo->new(
+ number => 10,
+ string => 'foo',
+ float => 10.5,
+ array => [ 1 .. 10 ],
+ hash => { map { $_ => undef } ( 1 .. 10 ) },
+ object => Foo->new( number => 2 ),
+ );
+ isa_ok( $foo, 'Foo' );
+
+ my $yaml = $foo->freeze({ 'format' => 'YAML' });
+
+ yaml_string_ok( $yaml, '... we got valid YAML out of it' );
+
+ is(
+ $yaml,
+ q{---
+__CLASS__: Foo
+array:
+ - 1
+ - 2
+ - 3
+ - 4
+ - 5
+ - 6
+ - 7
+ - 8
+ - 9
+ - 10
+float: 10.5
+hash:
+ 1: ~
+ 10: ~
+ 2: ~
+ 3: ~
+ 4: ~
+ 5: ~
+ 6: ~
+ 7: ~
+ 8: ~
+ 9: ~
+number: 10
+object:
+ __CLASS__: Foo
+ number: 2
+string: foo
+},
+ '... got the same YAML'
+ );
+
+}
+
+{
+ my $foo = Foo->thaw(
+ q{---
+__CLASS__: Foo
+array:
+ - 1
+ - 2
+ - 3
+ - 4
+ - 5
+ - 6
+ - 7
+ - 8
+ - 9
+ - 10
+float: 10.5
+hash:
+ 1: ~
+ 10: ~
+ 2: ~
+ 3: ~
+ 4: ~
+ 5: ~
+ 6: ~
+ 7: ~
+ 8: ~
+ 9: ~
+number: 10
+object:
+ __CLASS__: Foo
+ number: 2
+string: foo
+}, { 'format' => 'YAML' }
+ );
+ isa_ok( $foo, 'Foo' );
+
+ is( $foo->number, 10, '... got the right number' );
+ is( $foo->string, 'foo', '... got the right string' );
+ is( $foo->float, 10.5, '... got the right float' );
+ is_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
+ is_deeply(
+ $foo->hash,
+ { map { $_ => undef } ( 1 .. 10 ) },
+ '... got the right hash'
+ );
+
+ isa_ok( $foo->object, 'Foo' );
+ is( $foo->object->number, 2,
+ '... got the right number (in the embedded object)' );
+}
+
projects / gitmo/MooseX-Storage.git / commitdiff