--- /dev/null
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+MooseX-Storage-JSON-*
+cover_db
--- /dev/null
+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();
--- /dev/null
+Revision history for MooseX-Storage-JSON
+
+0.0.1 Tue Mar 27 16:37:53 2007
+ Initial release.
+
--- /dev/null
+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
--- /dev/null
+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-*' },
+);
--- /dev/null
+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.
--- /dev/null
+
+
+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
--- /dev/null
+
+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
--- /dev/null
+
+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
--- /dev/null
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'MooseX::Storage::JSON' );
+}
+
+diag( "Testing MooseX::Storage::JSON $MooseX::Storage::JSON::VERSION" );
--- /dev/null
+#!/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;
+
--- /dev/null
+#!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();
--- /dev/null
+#!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();
--- /dev/null
+#!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();
projects / gitmo/MooseX-Storage.git / commitdiff