From: Chris Prather <chris@prather.org>
Date: Wed, 28 Mar 2007 18:51:50 +0000 (+0000)
Subject: importing MooseX-Storage alpha cut (take 2)
X-Git-Tag: 0_02~38
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e59193fb8aa5245e3add439af907798562ff07c0;p=gitmo%2FMooseX-Storage.git

importing MooseX-Storage alpha cut (take 2)
---

diff --git a/.cvsignore b/.cvsignore
new file mode 100644
index 0000000..d57252a
--- /dev/null
+++ b/.cvsignore
@@ -0,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+MooseX-Storage-JSON-*
+cover_db
diff --git a/Build.PL b/Build.PL
new file mode 100644
index 0000000..77f2b77
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+    module_name         => 'MooseX::Storage::JSON',
+    license             => 'perl',
+    dist_author         => 'Chris Prather <perigrin@cpan.org>',
+    dist_version_from   => 'lib/MooseX/Storage/JSON.pm',
+    requires => {
+        'Test::More' => 0,
+        'version'    => 0,
+    },
+    add_to_cleanup      => [ 'MooseX-Storage-JSON-*' ],
+);
+
+$builder->create_build_script();
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..142479a
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for MooseX-Storage-JSON
+
+0.0.1  Tue Mar 27 16:37:53 2007
+       Initial release.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..d3ff02a
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,11 @@
+Build.PL
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+Makefile.PL
+README
+lib/MooseX/Storage/JSON.pm
+t/00.load.t
+t/perlcritic.t
+t/pod-coverage.t
+t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..73561c5
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'MooseX::Storage::JSON',
+    AUTHOR              => 'Chris Prather <perigrin@cpan.org>',
+    VERSION_FROM        => 'lib/MooseX/Storage/JSON.pm',
+    ABSTRACT_FROM       => 'lib/MooseX/Storage/JSON.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More' => 0,
+        'version'    => 0,
+    },
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+    clean               => { FILES => 'MooseX-Storage-JSON-*' },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..4490990
--- /dev/null
+++ b/README
@@ -0,0 +1,47 @@
+MooseX-Storage-JSON version 0.0.1
+
+[ REPLACE THIS...
+
+  The README is used to introduce the module and provide instructions on
+  how to install the module, any machine dependencies it may have (for
+  example C compilers and installed libraries) and any other information
+  that should be understood before the module is installed.
+
+  A README file is required for CPAN modules since CPAN extracts the
+  README file from a module distribution so that people browsing the
+  archive can use it get an idea of the modules uses. It is usually a
+  good idea to provide version information here so that people can
+  decide whether fixes for the module are worth downloading.
+]
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+
+Alternatively, to install with Module::Build, you can use the following commands:
+
+    perl Build.PL
+    ./Build
+    ./Build test
+    ./Build install
+
+
+
+DEPENDENCIES
+
+None.
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007, Chris Prather
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm
new file mode 100644
index 0000000..7078721
--- /dev/null
+++ b/lib/MooseX/Storage.pm
@@ -0,0 +1,24 @@
+
+
+package MooseX::Storage;
+
+sub import {
+    my $pkg = caller();
+    $pkg->meta->alias_method('Storage' => sub {
+        my $engine = shift;
+        return 'MooseX::Storage::' . $engine;
+    });
+}
+
+package MooseX::Storage::Base;
+use Moose::Role;
+
+requires 'load';
+requires 'store';
+
+requires 'freeze';
+requires 'thaw';
+
+1;
+
+__END__
\ No newline at end of file
diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm
new file mode 100644
index 0000000..6492260
--- /dev/null
+++ b/lib/MooseX/Storage/Engine.pm
@@ -0,0 +1,83 @@
+
+package MooseX::Storage::Engine;
+use Moose;
+
+has 'storage' => (
+    is  => 'rw',
+    isa => 'HashRef',
+    default => sub {{}}
+);
+
+has 'object' => (
+    is  => 'rw',
+    isa => 'Object',    
+);
+
+sub BUILD  { 
+	(shift)->collapse_object;
+}
+
+sub collapse_object {
+	my $self = shift;
+    $self->process_attributes;
+	return $self->storage;
+}
+
+sub extract_attributes {
+    my $self = shift;
+    return $self->object->meta->compute_all_applicable_attributes;
+}
+
+sub process_attributes {
+    my $self = shift;
+    foreach my $attr ($self->extract_attributes) {
+		next if $attr->name eq '_storage';
+        $self->process_attribute($attr);
+    }
+}
+
+sub process_attribute {
+    my ($self, $attr)  = @_;
+    $self->storage->{$attr->name} = $self->collapse_attribute($attr);
+}
+
+my %TYPES = (
+    'Int'      => sub { shift },
+    'Num'      => sub { shift },
+    'Str'      => sub { shift },
+    'ArrayRef' => sub { shift },
+    'HashRef'  => sub { shift },
+    'GlobRef' => sub { confess "FOO" },
+    'CodeRef' => sub { confess "This should use B::Deparse" },
+    'Object'  => sub {
+        my $obj = shift;
+		$obj || confess("Object Not Defined");
+        ($obj->does('MooseX::Storage::Base'))
+            || confess "Bad object";
+        $obj->pack();
+    }                    
+);
+
+sub match_type {
+    my ($self, $type_constraint) = @_;
+    return $TYPES{$type_constraint->name} if exists $TYPES{$type_constraint->name};
+    foreach my $type (keys %TYPES) {
+        return $TYPES{$type} 
+            if $type_constraint->is_subtype_of($type);
+    }
+}
+
+sub collapse_attribute {
+    my ($self, $attr)  = @_;
+	my $value = $attr->get_value($self->object);
+    if (defined $value && $attr->has_type_constraint) {
+        my $type_converter = $self->match_type($attr->type_constraint);
+        (defined $type_converter)
+            || confess "Cannot convert " . $attr->type_constraint->name;
+        $value = $type_converter->($value);
+    }
+	return $value;
+}
+
+1;
+__END__
\ No newline at end of file
diff --git a/lib/MooseX/Storage/JSON.pm b/lib/MooseX/Storage/JSON.pm
new file mode 100644
index 0000000..26ac774
--- /dev/null
+++ b/lib/MooseX/Storage/JSON.pm
@@ -0,0 +1,35 @@
+
+package MooseX::Storage::JSON;
+use Moose::Role;
+
+with 'MooseX::Storage::Base';
+
+use JSON::Syck;
+use MooseX::Storage::Engine;
+
+has '_storage' => (
+	is => 'ro',
+	isa => 'MooseX::Storage::Engine',
+	default => sub {
+		my $self = shift;
+		warn "Building Storage Engine\n";
+		MooseX::Storage::Engine->new(object => $self);
+	},
+	handles => {
+		'pack' => 'collapse_object',
+		# unpack here ...
+	}
+);
+
+sub load {}
+sub store {}
+sub thaw {}
+
+sub freeze {
+    my $self = shift;
+    JSON::Syck::Dump($self->pack());    
+}
+
+
+1;
+__END__
\ No newline at end of file
diff --git a/t/00.load.t b/t/00.load.t
new file mode 100644
index 0000000..fee8329
--- /dev/null
+++ b/t/00.load.t
@@ -0,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'MooseX::Storage::JSON' );
+}
+
+diag( "Testing MooseX::Storage::JSON $MooseX::Storage::JSON::VERSION" );
diff --git a/t/001_basic.t b/t/001_basic.t
new file mode 100644
index 0000000..548dacc
--- /dev/null
+++ b/t/001_basic.t
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+
+{
+    package Foo;
+    use Moose;
+    use MooseX::Storage;
+    
+    with Storage('JSON');
+    
+    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 'object' => (is => 'ro', isa => 'Object');    
+}
+
+my $foo = Foo->new(
+    number => 10,
+    string => 'foo',
+    float  => 10.5,
+    array => [ 1 .. 10 ],
+	object => Foo->new( number => 2 ),
+);
+
+diag $foo->freeze;
+
diff --git a/t/perlcritic.t b/t/perlcritic.t
new file mode 100644
index 0000000..7e7b210
--- /dev/null
+++ b/t/perlcritic.t
@@ -0,0 +1,9 @@
+#!perl
+
+if (!require Test::Perl::Critic) {
+    Test::More::plan(
+        skip_all => "Test::Perl::Critic required for testing PBP compliance"
+    );
+}
+
+Test::Perl::Critic::all_critic_ok();
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644
index 0000000..703f91d
--- /dev/null
+++ b/t/pod-coverage.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..976d7cd
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();