From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 30 Mar 2007 20:35:35 +0000 (+0000)
Subject: foo
X-Git-Tag: 0_02~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6f0912d0ed26989e6b2967e027597dba7bece25e;p=gitmo%2FMooseX-Storage.git

foo
---

diff --git a/lib/MooseX/Storage/Engine/IO/AtomicFile.pm b/lib/MooseX/Storage/Engine/IO/AtomicFile.pm
index 89fc8cf..902f7c5 100644
--- a/lib/MooseX/Storage/Engine/IO/AtomicFile.pm
+++ b/lib/MooseX/Storage/Engine/IO/AtomicFile.pm
@@ -12,7 +12,7 @@ has 'file' => (
 
 sub load { 
 	my ($self) = @_;
-	# NOTE:
+	# NOTE:sv
 	# AtomicFile gives us no real 
 	# benefit when reading, so why
 	# bother
diff --git a/lib/MooseX/Storage/Format/YAML.pm b/lib/MooseX/Storage/Format/YAML.pm
new file mode 100644
index 0000000..08525e9
--- /dev/null
+++ b/lib/MooseX/Storage/Format/YAML.pm
@@ -0,0 +1,78 @@
+
+package MooseX::Storage::Format::YAML;
+use Moose::Role;
+
+use Best [
+    [ qw[YAML::Syck YAML] ], 
+    [ qw[Load Dump] ]
+];
+
+requires 'pack';
+requires 'unpack';
+
+sub thaw {
+    my ( $class, $json ) = @_;
+    $class->unpack( Load($json) );
+}
+
+sub freeze {
+    my $self = shift;
+    Dump( $self->pack() );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Storage::Format::YAML
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<freeze>
+
+=item B<thaw ($json)>
+
+=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
+
+Chris Prather E<lt>chris.prather@iinteractive.comE<gt>
+
+Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 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
+
+
diff --git a/t/020_basic_yaml.t b/t/020_basic_yaml.t
new file mode 100644
index 0000000..9b2339e
--- /dev/null
+++ b/t/020_basic_yaml.t
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+use Test::YAML::Valid;
+
+BEGIN {
+    use_ok('MooseX::Storage');
+}
+
+{
+
+    package Foo;
+    use Moose;
+    use MooseX::Storage;
+
+    with Storage( 'format' => 'YAML' );
+
+    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 $yaml = $foo->freeze;
+    
+    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
+});
+    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)' );
+}
+
diff --git a/t/021_basic_yaml_io.t b/t/021_basic_yaml_io.t
new file mode 100644
index 0000000..f666115
--- /dev/null
+++ b/t/021_basic_yaml_io.t
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+
+BEGIN {
+    use_ok('MooseX::Storage');
+}
+
+{
+    package Foo;
+    use Moose;
+    use MooseX::Storage;
+    
+    with Storage(format => 'YAML', io => 'File');
+    
+    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 $file = 'temp.yaml';
+
+{
+    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');
+
+    $foo->store($file);
+}
+
+{
+    my $foo = Foo->load($file);
+    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)');
+}
+
+unlink $file;