-
package MooseX::Storage::Engine;
use Moose;
use Scalar::Util qw(refaddr);
-
package MooseX::Storage::Engine::IO::AtomicFile;
use Moose;
-
package MooseX::Storage::Engine::IO::File;
use Moose;
-
package MooseX::Storage::Format::JSON;
use Moose::Role;
-
package MooseX::Storage::Format::Storable;
use Moose::Role;
-
package MooseX::Storage::Meta::Attribute::DoNotSerialize;
use Moose;
package Foo;
use Moose;
use MooseX::Storage;
-
+
with Storage(
format => 'JSON',
io => 'File',
);
-
+
has 'number' => (is => 'ro', isa => 'Int');
has 'string' => (is => 'ro', isa => 'Str');
- has 'float' => (is => 'ro', isa => 'Num');
+ has 'float' => (is => 'ro', isa => 'Num');
has 'array' => (is => 'ro', isa => 'ArrayRef');
- has 'hash' => (is => 'ro', isa => 'HashRef');
- has 'object' => (is => 'ro', isa => 'Object');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
}
my $file = catfile($dir, 'temp.json');
=pod
-This extends the 001_basic test to
-show that subtypes will DWIM in most
+This extends the 001_basic test to
+show that subtypes will DWIM in most
cases.
=cut
use Scalar::Util 'looks_like_number';
- with Storage;
-
- subtype 'Natural'
+ with Storage;
+
+ subtype 'Natural'
=> as 'Int'
=> where { $_ > 0 };
-
- subtype 'HalfNum'
+
+ subtype 'HalfNum'
=> as 'Num'
- => where { "$_" =~ /\.5$/ };
-
+ => where { "$_" =~ /\.5$/ };
+
subtype 'FooString'
=> as 'Str'
=> where { lc($_) eq 'foo' };
-
- subtype 'IntArray'
+
+ subtype 'IntArray'
=> as 'ArrayRef'
=> where { scalar grep { looks_like_number($_) } @{$_} };
- subtype 'UndefHash'
+ subtype 'UndefHash'
=> as 'HashRef'
=> where { scalar grep { !defined($_) } values %{$_} };
object => Foo->new( number => 2 ),
);
isa_ok( $foo, 'Foo' );
-
+
cmp_deeply(
$foo->pack,
{
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- number => 2
- },
+ object => {
+ __CLASS__ => 'Foo',
+ number => 2
+ },
},
'... got the right frozen class'
);
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- number => 2
- },
- }
+ object => {
+ __CLASS__ => 'Foo',
+ number => 2
+ },
+ }
);
isa_ok( $foo, 'Foo' );
=pod
-This test checks the single level
-expansion and collpasing of the
+This test checks the single level
+expansion and collpasing of the
ArrayRef and HashRef type handlers.
=cut
use MooseX::Storage;
with Storage;
-
+
has 'number' => (is => 'ro', isa => 'Int');
-
+
package Foo;
use Moose;
use MooseX::Storage;
- with Storage;
+ with Storage;
- has 'bars' => (
- is => 'ro',
- isa => 'ArrayRef'
+ has 'bars' => (
+ is => 'ro',
+ isa => 'ArrayRef'
);
-
+
package Baz;
use Moose;
use MooseX::Storage;
- with Storage;
+ with Storage;
- has 'bars' => (
- is => 'ro',
- isa => 'HashRef'
- );
+ has 'bars' => (
+ is => 'ro',
+ isa => 'HashRef'
+ );
}
{
bars => [ map { Bar->new(number => $_) } (1 .. 10) ]
);
isa_ok( $foo, 'Foo' );
-
+
cmp_deeply(
$foo->pack,
{
__CLASS__ => 'Foo',
- bars => [
+ bars => [
map {
{
__CLASS__ => 'Bar',
number => $_,
- }
+ }
} (1 .. 10)
- ],
+ ],
},
'... got the right frozen class'
);
my $foo = Foo->unpack(
{
__CLASS__ => 'Foo',
- bars => [
+ bars => [
map {
{
__CLASS__ => 'Bar',
number => $_,
- }
+ }
} (1 .. 10)
- ],
- }
+ ],
+ }
);
isa_ok( $foo, 'Foo' );
bars => { map { ($_ => Bar->new(number => $_)) } (1 .. 10) }
);
isa_ok( $baz, 'Baz' );
-
+
cmp_deeply(
$baz->pack,
{
($_ => {
__CLASS__ => 'Bar',
number => $_,
- })
+ })
} (1 .. 10)
- },
+ },
},
'... got the right frozen class'
);
($_ => {
__CLASS__ => 'Bar',
number => $_,
- })
+ })
} (1 .. 10)
- },
- }
+ },
+ }
);
isa_ok( $baz, 'Baz' );
This test demonstrates two things:
- cycles will not work in the default engine
-- you can use a special metaclass to tell
+- you can use a special metaclass to tell
MooseX::Storage to skip an attribute
=cut
{
my $circular = Circular->new;
isa_ok($circular, 'Circular');
-
+
$circular->cycle($circular);
-
+
like(exception {
$circular->pack;
}, qr/^Basic Engine does not support cycles/,
with Storage;
has 'node' => (is => 'rw');
-
+
has 'children' => (
- is => 'ro',
- isa => 'ArrayRef',
+ is => 'ro',
+ isa => 'ArrayRef',
default => sub {[]}
);
-
+
has 'parent' => (
metaclass => 'DoNotSerialize',
- is => 'rw',
+ is => 'rw',
isa => 'Tree',
);
-
+
sub add_child {
my ($self, $child) = @_;
$child->parent($self);
{
my $t = Tree->new(node => 100);
isa_ok($t, 'Tree');
-
+
cmp_deeply(
- $t->pack,
+ $t->pack,
{
__CLASS__ => 'Tree',
node => 100,
children => [],
},
'... got the right packed version');
-
+
my $t2 = Tree->new(node => 200);
- isa_ok($t2, 'Tree');
-
+ isa_ok($t2, 'Tree');
+
$t->add_child($t2);
-
+
cmp_deeply($t->children, [ $t2 ], '... got the right children in $t');
-
+
is($t2->parent, $t, '... created the cycle correctly');
- isa_ok($t2->parent, 'Tree');
-
+ isa_ok($t2->parent, 'Tree');
+
cmp_deeply(
- $t->pack,
+ $t->pack,
{
__CLASS__ => 'Tree',
node => 100,
{
__CLASS__ => 'Tree',
node => 200,
- children => [],
- }
+ children => [],
+ }
],
},
- '... got the right packed version (with parent attribute skipped in child)');
-
+ '... got the right packed version (with parent attribute skipped in child)');
+
cmp_deeply(
- $t2->pack,
+ $t2->pack,
{
__CLASS__ => 'Tree',
node => 200,
- children => [],
+ children => [],
},
'... got the right packed version (with parent attribute skipped)');
}
use Moose;
use MooseX::Storage;
with Storage;
-
+
has 'x' => ( is => 'rw', isa => 'HashRef' );
has 'y' => ( is => 'rw', isa => 'HashRef' );
}
ok( Double->unpack( $pack || {} ),
" And unpacked again" );
}
-
+
my $pack = $double->pack( engine_traits => [qw/DisableCycleDetection/] );
ok( $pack, " Object packs when cycle check is disabled");
ok( Double->unpack( $pack ),
" And unpacked again" );
-}
+}
### the same as above, but now done with a trait
### this fails with cycle detection on
use Moose;
use MooseX::Storage;
with Storage( traits => ['DisableCycleDetection'] );
-
+
has 'x' => ( is => 'rw', isa => 'HashRef' );
has 'y' => ( is => 'rw', isa => 'HashRef' );
}
ok( $pack, "Object packs with DisableCycleDetection trait");
ok( DoubleNoCycle->unpack( $pack ),
" Unpacked again" );
-}
+}
=pod
-This tests that the version and authority
+This tests that the version and authority
checks are performed upon object expansion.
=cut
package Bar;
use Moose;
use MooseX::Storage;
-
+
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:JRANDOM';
with Storage;
-
+
has 'number' => (is => 'ro', isa => 'Int');
-
+
package Foo;
use Moose;
use MooseX::Storage;
our $VERSION = '0.01';
- our $AUTHORITY = 'cpan:JRANDOM';
+ our $AUTHORITY = 'cpan:JRANDOM';
- with Storage;
+ with Storage;
- has 'bar' => (
- is => 'ro',
- isa => 'Bar'
- );
+ has 'bar' => (
+ is => 'ro',
+ isa => 'Bar'
+ );
}
{
bar => Bar->new(number => 1)
);
isa_ok( $foo, 'Foo' );
-
+
cmp_deeply(
$foo->pack,
{
bar => {
__CLASS__ => 'Bar-0.01-cpan:JRANDOM',
number => 1,
- }
+ }
},
'... got the right frozen class'
);
bar => {
__CLASS__ => 'Bar-0.01-cpan:JRANDOM',
number => 1,
- }
- },
+ }
+ },
);
isa_ok( $foo, 'Foo' );
isa_ok( $foo->bar, 'Bar' );
is( $foo->bar->number, 1 , '... got the right number too' );
-
+
}
-Moose::Meta::Class->create('Bar',
+Moose::Meta::Class->create('Bar',
version => '0.02',
authority => 'cpan:JRANDOM',
);
bar => {
__CLASS__ => 'Bar-0.01-cpan:JRANDOM',
number => 1,
- }
- }
+ }
+ }
);
}, '... could not unpack, versions are different ' . $@);
-Moose::Meta::Class->create('Bar',
+Moose::Meta::Class->create('Bar',
version => '0.01',
authority => 'cpan:DSTATIC',
);
bar => {
__CLASS__ => 'Bar-0.01-cpan:JRANDOM',
number => 1,
- }
- }
+ }
+ }
);
}, '... could not unpack, authorities are different');
BEGIN {
use_ok('MooseX::Storage');
- use_ok('MooseX::Storage::Engine');
+ use_ok('MooseX::Storage::Engine');
}
=pod
-This is just a simple example of defining
+This is just a simple example of defining
a custom type handler to take care of custom
-inflate and deflate needs.
+inflate and deflate needs.
=cut
{
package Bar;
use Moose;
-
+
has 'baz' => (is => 'rw', isa => 'Str');
- has 'boo' => (is => 'rw', isa => 'Str');
-
+ has 'boo' => (is => 'rw', isa => 'Str');
+
sub encode {
my $self = shift;
$self->baz . '|' . $self->boo;
}
-
+
sub decode {
my ($class, $packed) = @_;
my ($baz, $boo) = split /\|/ => $packed;
boo => $boo,
);
}
-
+
MooseX::Storage::Engine->add_custom_type_handler(
'Bar' => (
expand => sub { Bar->decode(shift) },
collapse => sub { (shift)->encode },
)
);
-
+
package Foo;
use Moose;
use MooseX::Storage;
-
+
with Storage;
-
+
has 'bar' => (
is => 'ro',
isa => 'Bar',
bar => "BAZ|BOO",
});
isa_ok($foo, 'Foo');
-
- isa_ok($foo->bar, 'Bar');
-
+
+ isa_ok($foo->bar, 'Bar');
+
is($foo->bar->baz, 'BAZ', '... got the right stuff');
is($foo->bar->boo, 'BOO', '... got the right stuff');
}
boolean => 0,
);
isa_ok( $foo, 'Foo' );
-
+
is($foo->boolean, 0, '... got the right boolean value');
-
+
cmp_deeply(
$foo->pack,
{
number => 0,
string => '',
boolean => 0,
- }
+ }
);
isa_ok( $foo, 'Foo' );
has 'bar' => (
metaclass => 'DoNotSerialize',
is => 'rw',
- default => sub { 'BAR' }
+ default => sub { 'BAR' }
);
-
+
has 'baz' => (
traits => [ 'DoNotSerialize' ],
is => 'rw',
- default => sub { 'BAZ' }
- );
-
+ default => sub { 'BAZ' }
+ );
+
has 'gorch' => (
- is => 'rw',
+ is => 'rw',
default => sub { 'GORCH' }
- );
+ );
1;
}
{ my $foo = Foo->new;
isa_ok($foo, 'Foo');
-
+
is($foo->bar, 'BAR', '... got the value we expected');
is($foo->baz, 'BAZ', '... got the value we expected');
is($foo->gorch, 'GORCH', '... got the value we expected');
-
+
cmp_deeply(
$foo->pack,
{
is => 'rw',
isa => 'Object', # type constraint is important
);
-
+
has zot => (
default => sub { $$ },
is => 'rw',
- );
+ );
}
{ my $obj = bless {};
my $bar = Bar->new( foo => $obj );
-
+
ok( $bar, "New object created" );
is( $bar->foo, $obj, " ->foo => $obj" );
is( $bar->zot, $$, " ->zot => $$" );
-
+
my $bpack = $bar->pack;
cmp_deeply(
$bpack,
{ __CLASS__ => 'Bar',
zot => $$,
}, " Packed correctly" );
-
+
eval { Bar->unpack( $bpack ) };
ok( $@, " Unpack without required attribute fails" );
like( $@, qr/foo/, " Proper error recorded" );
-
+
my $bar2 = Bar->unpack( $bpack, inject => { foo => bless {} } );
- ok( $bar2, " Unpacked correctly with foo => Object");
-}
-
-
-
-
+ ok( $bar2, " Unpacked correctly with foo => Object");
+}
+
+
+
+
has 'x' => (is => 'rw', lazy_build => 1 );
has 'y' => (is => 'rw', lazy_build => 1 );
has 'z' => (is => 'rw', builder => '_build_z' );
-
-
+
+
sub _build_x { 'x' }
sub _build_y { 'y' }
sub _build_z { 'z' }
is( $href->{'z'}, 'z', " z => z" );
ok( not(exists($href->{'y'})), " y does not exist" );
-cmp_deeply(
- $href,
+cmp_deeply(
+ $href,
{ '__CLASS__' => 'Point',
'x' => $$,
'z' => 'z'
};
BEGIN {
- # NOTE:
- # this is because JSON::XS is
+ # NOTE:
+ # this is because JSON::XS is
# the only one which really gets
# utf8 correct
- # - SL
+ # - SL
BEGIN {
$ENV{JSON_ANY_ORDER} = qw(XS);
$ENV{JSON_ANY_CONFIG} = "utf8=0,canonical=1";
use MooseX::Storage;
with Storage( 'format' => 'JSON' );
-
+
has 'utf8_string' => (
is => 'rw',
isa => 'Str',
my $foo2 = Foo->thaw($json);
isa_ok( $foo, 'Foo' );
-
- is($foo2->utf8_string,
- "ネットスーパー (Internet Shopping)",
+
+ is($foo2->utf8_string,
+ "ネットスーパー (Internet Shopping)",
'... got the string we expected');
-
+
is($foo2->freeze,
'{"__CLASS__":"Foo","utf8_string":"ネットスーパー (Internet Shopping)"}',
- '... got the right JSON');
+ '... got the right JSON');
}
{
$test_string = "ネットスーパー (Internet Shopping)";
no utf8;
}
-
+
ok(utf8::is_utf8($test_string), '... got a utf8 string');
- ok(utf8::valid($test_string), '... got a valid utf8 string');
-
+ ok(utf8::valid($test_string), '... got a valid utf8 string');
+
Encode::_utf8_off($test_string);
-
+
ok(!utf8::is_utf8($test_string), '... no longer is utf8 string');
- ok(utf8::valid($test_string), '... got a valid utf8 string');
-
+ ok(utf8::valid($test_string), '... got a valid utf8 string');
+
my $foo = Foo->new(
utf8_string => $test_string
);
ok(utf8::valid($foo->utf8_string), '... but is a valid utf8 string');
my $json = $foo->freeze;
-
+
ok(utf8::is_utf8($json), '... is a utf8 string now');
- ok(utf8::valid($json), '... got a valid utf8 string');
+ ok(utf8::valid($json), '... got a valid utf8 string');
is($json,
'{"__CLASS__":"Foo","utf8_string":"ネットスーパー (Internet Shopping)"}',
- '... got the right JSON');
+ '... got the right JSON');
}
object => Foo->new( number => 2 ),
);
isa_ok( $foo, 'Foo' );
-
+
my $packed = $foo->pack;
-
+
cmp_deeply(
$packed,
{
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- __DIGEST__ => re('[0-9a-f]+'),
- number => 2
- },
+ object => {
+ __CLASS__ => 'Foo',
+ __DIGEST__ => re('[0-9a-f]+'),
+ number => 2
+ },
},
'... got the right frozen class'
);
$foo2 = Foo->unpack($packed);
}, undef, '... unpacked okay');
isa_ok($foo2, 'Foo');
-
+
cmp_deeply(
$foo2->pack,
{
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- __DIGEST__ => re('[0-9a-f]+'),
- number => 2
- },
+ object => {
+ __CLASS__ => 'Foo',
+ __DIGEST__ => re('[0-9a-f]+'),
+ number => 2
+ },
},
'... got the right frozen class'
- );
+ );
}
{
BEGIN {
use_ok('MooseX::Storage');
- use_ok('MooseX::Storage::Util');
+ use_ok('MooseX::Storage::Util');
}
my $packed = {
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- number => 2
- },
+ object => {
+ __CLASS__ => 'Foo',
+ number => 2
+ },
};
my $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"}';
-my $yaml = q{---
+my $yaml = q{---
__CLASS__: Foo
-array:
+array:
- 1
- 2
- 3
- 9
- 10
float: 10.5
-hash:
+hash:
1: ~
10: ~
2: ~
8: ~
9: ~
number: 10
-object:
+object:
__CLASS__: Foo
number: 2
string: foo
};
-is('Foo', MooseX::Storage::Util->peek($packed),
+is('Foo', MooseX::Storage::Util->peek($packed),
'... got the right class name from the packed item');
SKIP: {
- my $classname = eval {
- MooseX::Storage::Util->peek($json => ('format' => 'JSON'))
+ my $classname = eval {
+ MooseX::Storage::Util->peek($json => ('format' => 'JSON'))
};
if ($@ =~ /^Could not load JSON module because/) {
skip "No JSON module found", 1;
}
- is('Foo', $classname,
+ is('Foo', $classname,
'... got the right class name from the json item');
}
SKIP: {
- my $classname = eval {
+ my $classname = eval {
MooseX::Storage::Util->peek($yaml => ('format' => 'YAML'))
};
if ($@ =~ /^Could not load YAML module because/
or $@ =~ /^Can't locate Best/
) {
skip "No YAML module found", 1;
- }
-
- is('Foo', $classname,
+ }
+
+ is('Foo', $classname,
'... got the right class name from the yaml item');
}
object => Foo->new( number => 2 ),
);
isa_ok( $foo, 'Foo' );
-
+
my $stored = $foo->freeze;
my $struct = Storable::thaw($stored);
'__CLASS__' => 'Foo',
'float' => 10.5,
'number' => 10,
- 'string' => 'foo',
+ 'string' => 'foo',
'array' => [ 1 .. 10],
- 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'hash' => { map { $_ => undef } 1 .. 10 },
'object' => {
'__CLASS__' => 'Foo',
'number' => 2
'__CLASS__' => 'Foo',
'float' => 10.5,
'number' => 10,
- 'string' => 'foo',
+ 'string' => 'foo',
'array' => [ 1 .. 10],
- 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'hash' => { map { $_ => undef } 1 .. 10 },
'object' => {
'__CLASS__' => 'Foo',
'number' => 2
},
});
-
+
my $foo = Foo->thaw($stored);
isa_ok( $foo, 'Foo' );
{
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' }
+ { 'format' => 'JSON' }
);
isa_ok( $foo, 'Foo' );
object => Foo->new( number => 2 ),
);
isa_ok( $foo, 'Foo' );
-
+
my $stored = $foo->freeze({ 'format' => 'Storable' });
my $struct = Storable::thaw($stored);
'__CLASS__' => 'Foo',
'float' => 10.5,
'number' => 10,
- 'string' => 'foo',
+ 'string' => 'foo',
'array' => [ 1 .. 10],
- 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'hash' => { map { $_ => undef } 1 .. 10 },
'object' => {
'__CLASS__' => 'Foo',
'number' => 2
'__CLASS__' => 'Foo',
'float' => 10.5,
'number' => 10,
- 'string' => 'foo',
+ 'string' => 'foo',
'array' => [ 1 .. 10],
- 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'hash' => { map { $_ => undef } 1 .. 10 },
'object' => {
'__CLASS__' => 'Foo',
'number' => 2
},
});
-
+
my $foo = Foo->thaw($stored, { 'format' => 'Storable' });
isa_ok( $foo, 'Foo' );
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 'float' => (is => 'ro', isa => 'Num');
has 'array' => (is => 'ro', isa => 'ArrayRef');
- has 'hash' => (is => 'ro', isa => 'HashRef');
- has 'object' => (is => 'ro', isa => 'Object');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
}
my $file = catfile($dir, 'temp.json');
object => Foo->new( number => 2 ),
);
isa_ok( $foo, 'Foo' );
-
+
cmp_deeply(
$foo->pack,
{
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- number => 2
- },
+ object => {
+ __CLASS__ => 'Foo',
+ number => 2
+ },
},
'... got the right frozen class'
);
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- number => 2
- },
- }
+ object => {
+ __CLASS__ => 'Foo',
+ number => 2
+ },
+ }
);
isa_ok( $foo, 'Foo' );
use Scalar::Util 'looks_like_number';
- with Storage;
-
- subtype 'Natural'
+ with Storage;
+
+ subtype 'Natural'
=> as 'Int'
=> where { $_ > 0 };
-
- subtype 'HalfNum'
+
+ subtype 'HalfNum'
=> as 'Num'
- => where { "$_" =~ /\.5$/ };
-
+ => where { "$_" =~ /\.5$/ };
+
subtype 'FooString'
=> as 'Str'
=> where { lc($_) eq 'foo' };
-
- subtype 'IntArray'
+
+ subtype 'IntArray'
=> as 'ArrayRef'
=> where { scalar grep { looks_like_number($_) } @{$_} };
- subtype 'UndefHash'
+ subtype 'UndefHash'
=> as 'HashRef'
=> where { scalar grep { !defined($_) } values %{$_} };
object => Foo->new( number => 2 ),
);
isa_ok( $foo, 'Foo' );
-
+
cmp_deeply(
$foo->pack,
{
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- number => 2
- },
+ object => {
+ __CLASS__ => 'Foo',
+ number => 2
+ },
},
'... got the right frozen class'
);
float => 10.5,
array => [ 1 .. 10 ],
hash => { map { $_ => undef } ( 1 .. 10 ) },
- object => {
- __CLASS__ => 'Foo',
- number => 2
- },
- }
+ object => {
+ __CLASS__ => 'Foo',
+ number => 2
+ },
+ }
);
isa_ok( $foo, 'Foo' );
package Foo;
use Moose;
use MooseX::Storage;
-
+
with Storage(format => 'JSON', io => 'File');
-
+
has 'number' => (is => 'ro', isa => 'Int');
has 'string' => (is => 'ro', isa => 'Str');
- has 'float' => (is => 'ro', isa => 'Num');
+ has 'float' => (is => 'ro', isa => 'Num');
has 'array' => (is => 'ro', isa => 'ArrayRef');
- has 'hash' => (is => 'ro', isa => 'HashRef');
- has 'object' => (is => 'ro', isa => 'Object');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
}
my $file = catfile( $dir, 'temp.json' );
package Foo;
use Moose;
use MooseX::Storage;
-
+
with Storage(format => 'JSON', io => 'AtomicFile');
-
+
has 'number' => (is => 'ro', isa => 'Int');
has 'string' => (is => 'ro', isa => 'Str');
- has 'float' => (is => 'ro', isa => 'Num');
+ has 'float' => (is => 'ro', isa => 'Num');
has 'array' => (is => 'ro', isa => 'ArrayRef');
- has 'hash' => (is => 'ro', isa => 'HashRef');
- has 'object' => (is => 'ro', isa => 'Object');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
}
my $file = catfile($dir,'temp.json');
package Foo;
use Moose;
use MooseX::Storage;
-
+
with Storage(io => 'StorableFile');
-
+
has 'number' => (is => 'ro', isa => 'Int');
has 'string' => (is => 'ro', isa => 'Str');
- has 'float' => (is => 'ro', isa => 'Num');
+ has 'float' => (is => 'ro', isa => 'Num');
has 'array' => (is => 'ro', isa => 'ArrayRef');
- has 'hash' => (is => 'ro', isa => 'HashRef');
- has 'object' => (is => 'ro', isa => 'Object');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
}
my $file = catfile($dir,'temp.storable');
package Foo;
use Moose;
use MooseX::Storage;
-
+
with Storage(io => 'StorableFile');
-
+
has 'number' => (is => 'ro', isa => 'Int');
has 'string' => (is => 'rw', isa => 'Str');
- has 'float' => (is => 'ro', isa => 'Num');
+ has 'float' => (is => 'ro', isa => 'Num');
has 'array' => (is => 'ro', isa => 'ArrayRef');
- has 'hash' => (is => 'ro', isa => 'HashRef');
- has 'object' => (is => 'ro', isa => 'Object');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
## add some custom freeze/thaw hooks here ...
isa_ok($foo, 'Foo');
$foo->store($file);
-
+
# check our custom freeze hook fired ...
my $data = Storable::retrieve($file);
cmp_deeply(
'__CLASS__' => 'Foo',
'float' => 10.5,
'number' => 10,
- 'string' => 'HELLO WORLD',
+ 'string' => 'HELLO WORLD',
'array' => [ 1 .. 10],
- 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'hash' => { map { $_ => undef } 1 .. 10 },
'object' => {
'__CLASS__' => 'Foo',
'number' => 2
},
},
'... got the data struct we expected'
- );
-
+ );
+
}
{
'IO::AtomicFile' => 0.01,
};
-BEGIN {
- # NOTE:
- # this is because JSON::XS is
+BEGIN {
+ # NOTE:
+ # this is because JSON::XS is
# the only one which really gets
# utf8 correct
- # - SL
+ # - SL
BEGIN {
$ENV{JSON_ANY_ORDER} = qw(XS);
$ENV{JSON_ANY_CONFIG} = "utf8=0,canonical=1";
use MooseX::Storage;
with Storage( 'format' => 'JSON', 'io' => 'File' );
-
+
has 'utf8_string' => (
is => 'rw',
isa => 'Str',
{
my $foo = Foo->new;
isa_ok( $foo, 'Foo' );
-
- $foo->store($file);
+
+ $foo->store($file);
}
{
my $foo = Foo->load($file);
isa_ok($foo, 'Foo');
- is($foo->utf8_string,
- "ネットスーパー (Internet Shopping)",
+ is($foo->utf8_string,
+ "ネットスーパー (Internet Shopping)",
'... got the string we expected');
}
utf8_string => 'Escritório'
);
isa_ok( $foo, 'Foo' );
-
- $foo->store($file);
+
+ $foo->store($file);
}
{
my $foo = Foo->load($file);
isa_ok($foo, 'Foo');
-
+
ok(utf8::is_utf8($foo->utf8_string), '... the string is still utf8');
- is($foo->utf8_string,
- "Escritório",
+ is($foo->utf8_string,
+ "Escritório",
'... got the string we expected');
}
'IO::AtomicFile' => 0.01,
};
-BEGIN {
- # NOTE:
- # this is because JSON::XS is
+BEGIN {
+ # NOTE:
+ # this is because JSON::XS is
# the only one which really gets
# utf8 correct
- # - SL
+ # - SL
BEGIN {
$ENV{JSON_ANY_ORDER} = qw(XS);
$ENV{JSON_ANY_CONFIG} = "utf8=0,canonical=1";
use MooseX::Storage;
with Storage( 'format' => 'JSON', 'io' => 'AtomicFile' );
-
+
has 'utf8_string' => (
is => 'rw',
isa => 'Str',
{
my $foo = Foo->new;
isa_ok( $foo, 'Foo' );
-
- $foo->store($file);
+
+ $foo->store($file);
}
{
my $foo = Foo->load($file);
isa_ok($foo, 'Foo');
- is($foo->utf8_string,
- "ネットスーパー (Internet Shopping)",
+ is($foo->utf8_string,
+ "ネットスーパー (Internet Shopping)",
'... got the string we expected');
}
utf8_string => 'Escritório'
);
isa_ok( $foo, 'Foo' );
-
- $foo->store($file);
+
+ $foo->store($file);
}
{
my $foo = Foo->load($file);
isa_ok($foo, 'Foo');
-
+
ok(utf8::is_utf8($foo->utf8_string), '... the string is still utf8');
- is($foo->utf8_string,
- "Escritório",
+ is($foo->utf8_string,
+ "Escritório",
'... got the string we expected');
}
projects / gitmo/MooseX-Storage.git / commitdiff