From: Stevan Little Date: Tue, 26 Jun 2007 21:50:00 +0000 (+0000) Subject: MooseX::Storage - added peek() X-Git-Tag: 0_03~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Storage.git;a=commitdiff_plain;h=69b45b7d79fa7628879179765a6deba184f92fdf MooseX::Storage - added peek() --- diff --git a/Changes b/Changes index d6afb77..fcd6ab6 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,13 @@ Revision history for MooseX-Storage 0.03 + * MooseX::Storage::Util + - this is a collection of useful tools + for working with MooseX::Storage data + - added docs and test + + * t/ + - added test for a custom type handler 0.02 Fri. June 8, 2007 * MooseX::Storage::Base::WithChecksum diff --git a/MANIFEST b/MANIFEST index c59667b..2e3267b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -16,6 +16,7 @@ lib/MooseX/Storage/Format/YAML.pm lib/MooseX/Storage/IO/AtomicFile.pm lib/MooseX/Storage/IO/File.pm lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm +lib/MooseX/Storage/Util.pm t/000_load.t t/001_basic.t t/002_basic_w_subtypes.t @@ -26,6 +27,7 @@ t/006_w_custom_type_handlers.t t/010_basic_json.t t/020_basic_yaml.t t/030_with_checksum.t +t/040_basic_utils.t t/100_io.t t/101_io_atomic.t t/pod-coverage.t diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm index b58562f..192c6ee 100644 --- a/lib/MooseX/Storage.pm +++ b/lib/MooseX/Storage.pm @@ -4,7 +4,8 @@ use Moose qw(confess); use MooseX::Storage::Meta::Attribute::DoNotSerialize; -our $VERSION = '0.03'; +our $VERSION = '0.03'; +our $AUTHORITY = 'cpan:STEVAN'; sub import { my $pkg = caller(); diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm index 1772d6f..a1215e4 100644 --- a/lib/MooseX/Storage/Base/WithChecksum.pm +++ b/lib/MooseX/Storage/Base/WithChecksum.pm @@ -7,7 +7,8 @@ use Data::Dumper (); use MooseX::Storage::Engine; -our $VERSION = '0.01'; +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; our $DIGEST_MARKER = '__DIGEST__'; diff --git a/lib/MooseX/Storage/Basic.pm b/lib/MooseX/Storage/Basic.pm index 2a610c9..a572668 100644 --- a/lib/MooseX/Storage/Basic.pm +++ b/lib/MooseX/Storage/Basic.pm @@ -4,7 +4,8 @@ use Moose::Role; use MooseX::Storage::Engine; -our $VERSION = '0.01'; +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; sub pack { my ( $self, @args ) = @_; diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm index a90c3ea..7a266dd 100644 --- a/lib/MooseX/Storage/Engine.pm +++ b/lib/MooseX/Storage/Engine.pm @@ -2,7 +2,8 @@ package MooseX::Storage::Engine; use Moose; -our $VERSION = '0.02'; +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; # the class marker when # serializing an object. diff --git a/lib/MooseX/Storage/Engine/IO/AtomicFile.pm b/lib/MooseX/Storage/Engine/IO/AtomicFile.pm index 2978b10..6c58228 100644 --- a/lib/MooseX/Storage/Engine/IO/AtomicFile.pm +++ b/lib/MooseX/Storage/Engine/IO/AtomicFile.pm @@ -4,7 +4,8 @@ use Moose; use IO::AtomicFile; -our $VERSION = '0.02'; +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; extends 'MooseX::Storage::Engine::IO::File'; diff --git a/lib/MooseX/Storage/Engine/IO/File.pm b/lib/MooseX/Storage/Engine/IO/File.pm index b87f6a3..eb92a04 100644 --- a/lib/MooseX/Storage/Engine/IO/File.pm +++ b/lib/MooseX/Storage/Engine/IO/File.pm @@ -4,7 +4,8 @@ use Moose; use IO::File; -our $VERSION = '0.02'; +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; has 'file' => ( is => 'ro', diff --git a/lib/MooseX/Storage/Format/JSON.pm b/lib/MooseX/Storage/Format/JSON.pm index 9682d6c..e26cadb 100644 --- a/lib/MooseX/Storage/Format/JSON.pm +++ b/lib/MooseX/Storage/Format/JSON.pm @@ -6,7 +6,8 @@ no warnings 'once'; use JSON::Any; -our $VERSION = '0.02'; +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; requires 'pack'; requires 'unpack'; diff --git a/lib/MooseX/Storage/Format/YAML.pm b/lib/MooseX/Storage/Format/YAML.pm index 08bc3c4..8f38803 100644 --- a/lib/MooseX/Storage/Format/YAML.pm +++ b/lib/MooseX/Storage/Format/YAML.pm @@ -11,7 +11,8 @@ use Best [ [ qw[Load Dump] ] ]; -our $VERSION = '0.02'; +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; requires 'pack'; requires 'unpack'; diff --git a/lib/MooseX/Storage/IO/AtomicFile.pm b/lib/MooseX/Storage/IO/AtomicFile.pm index 50977ce..a32638b 100644 --- a/lib/MooseX/Storage/IO/AtomicFile.pm +++ b/lib/MooseX/Storage/IO/AtomicFile.pm @@ -4,7 +4,8 @@ use Moose::Role; use MooseX::Storage::Engine::IO::AtomicFile; -our $VERSION = '0.01'; +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; with 'MooseX::Storage::IO::File'; diff --git a/lib/MooseX/Storage/IO/File.pm b/lib/MooseX/Storage/IO/File.pm index cbff2d0..a276812 100644 --- a/lib/MooseX/Storage/IO/File.pm +++ b/lib/MooseX/Storage/IO/File.pm @@ -4,7 +4,8 @@ use Moose::Role; use MooseX::Storage::Engine::IO::File; -our $VERSION = '0.01'; +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; requires 'thaw'; requires 'freeze'; diff --git a/lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm b/lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm index b309eb7..2ffd1da 100644 --- a/lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm +++ b/lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm @@ -2,14 +2,16 @@ package MooseX::Storage::Meta::Attribute::DoNotSerialize; use Moose; -our $VERSION = '0.01'; +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; extends 'Moose::Meta::Attribute'; # register this alias ... package Moose::Meta::Attribute::Custom::DoNotSerialize; -our $VERSION = '0.01'; +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; sub register_implementation { 'MooseX::Storage::Meta::Attribute::DoNotSerialize' } diff --git a/lib/MooseX/Storage/Util.pm b/lib/MooseX/Storage/Util.pm new file mode 100644 index 0000000..e13ea97 --- /dev/null +++ b/lib/MooseX/Storage/Util.pm @@ -0,0 +1,147 @@ +package MooseX::Storage::Util; +use Moose qw(confess blessed); + +use MooseX::Storage::Engine (); + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +sub peek { + my ($class, $data, %options) = @_; + + if (exists $options{'format'}) { + + my $inflater = $class->can('_inflate_' . lc($options{'format'})); + + (defined $inflater) + || confess "No inflater found for " . $options{'format'}; + + $data = $class->$inflater($data); + } + + (ref($data) && ref($data) eq 'HASH' && !blessed($data)) + || confess "The data has to be a HASH reference, but not blessed"; + + $options{'key'} ||= $MooseX::Storage::Engine::CLASS_MARKER; + + return $data->{$options{'key'}}; + +} + +sub _inflate_json { + my ($class, $json) = @_; + + require JSON::Any; + JSON::Any->import; + + my $data = eval { JSON::Any->jsonToObj($json) }; + if ($@) { + confess "There was an error when attempting to peek at JSON: $@"; + } + + return $data; +} + +sub _inflate_yaml { + my ($class, $yaml) = @_; + + require Best; + Best->import([[ qw[YAML::Syck YAML] ]]); + + my $inflater = Best->which('YAML::Syck')->can('Load'); + + (defined $inflater) + || confess "Could not load the YAML inflator"; + + my $data = eval { $inflater->($yaml) }; + if ($@) { + confess "There was an error when attempting to peek at YAML : $@"; + } + return $data; +} + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::Storage::Util - A MooseX::Storage swiss-army chainsaw + +=head1 DESCRIPTION + +This module provides a set of tools, some sharp and focused, +others more blunt and crude. But no matter what, they are useful +bits to have around when dealing with MooseX::Storage code. + +=head1 METHODS + +All the methods in this package are class methods and should +be called appropriately. + +=over 4 + +=item B + +This method will help you to verify that the serialized class you +have gotten is what you expect it to be before you actually +unfreeze/unpack it. + +The C<$data> can be either a perl HASH ref or some kind of serialized +data (JSON, YAML, etc.). + +The C<%options> are as follows: + +=over 4 + +=item I + +If this is left blank, we assume that C<$data> is a plain perl HASH ref +otherwise we attempt to inflate C<$data> based on the value of this option. + +Currently only JSON and YAML are supported here. + +=item I + +The default is to try and extract the class name, but if you want to check +another key in the data, you can set this option. It will return the value +found in the key for you. + +=back + +=back + +=head2 Introspection + +=over 4 + +=item B + +=back + +=head1 TODO + +Add more stuff to this module :) + +=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 Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 by Infinity Interactive, Inc. + +L + +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/040_basic_utils.t b/t/040_basic_utils.t new file mode 100644 index 0000000..802e841 --- /dev/null +++ b/t/040_basic_utils.t @@ -0,0 +1,74 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 5; + +BEGIN { + use_ok('MooseX::Storage'); + use_ok('MooseX::Storage::Util'); +} + +my $packed = { + __CLASS__ => 'Foo', + number => 10, + string => 'foo', + float => 10.5, + array => [ 1 .. 10 ], + hash => { map { $_ => undef } ( 1 .. 10 ) }, + 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{--- +__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 +}; + +is( +'Foo', +MooseX::Storage::Util->peek($packed), +'... got the right class name from the packed item'); + +is( +'Foo', +MooseX::Storage::Util->peek($json => ('format' => 'JSON')), +'... got the right class name from the json item'); + +is( +'Foo', +MooseX::Storage::Util->peek($yaml => ('format' => 'YAML')), +'... got the right class name from the yaml item'); + +