Commits

Toby Inkster committed 5138b3c

initial commit

Comments (0)

Files changed (22)

+use inc::Module::Package 'RDF:tobyink 0.009';
+

lib/Acme/MooseX/JSON.pm

+package Acme::MooseX::JSON;
+
+use 5.008;
+use strict;
+use warnings;
+
+our $AUTHORITY = 'cpan:TOBYINK';
+our $VERSION   = '0.001';
+
+use Moose ();
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+use Scalar::Accessors::LikeHash::JSON ();
+
+my $ACCESSORS = "Scalar::Accessors::LikeHash::JSON";
+
+BEGIN {
+	package Acme::MooseX::JSON::Trait::Class;
+	use Moose::Role;
+	our $AUTHORITY = 'cpan:TOBYINK';
+	our $VERSION   = '0.001';
+};
+
+BEGIN {
+	package Acme::MooseX::JSON::Trait::Instance;
+	use Moose::Role;
+	our $AUTHORITY = 'cpan:TOBYINK';
+	our $VERSION   = '0.001';
+	
+	override create_instance => sub {
+		my $meta  = shift;
+		my $class = $meta->associated_metaclass;
+		my $str   = "{}";
+		bless \$str, $class->name;
+	};
+	
+	override clone_instance => sub {
+		my ($meta, $instance) = @_;
+		my $class = $meta->associated_metaclass;
+		my $str   = $$instance;
+		bless \$str, $class->name;
+	};
+	
+	override get_slot_value => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		return $ACCESSORS->fetch($instance, $slot_name);
+	};
+	
+	override set_slot_value => sub {
+		my ($meta, $instance, $slot_name, $value) = @_;
+		return $ACCESSORS->store($instance, $slot_name, $value);
+	};
+	
+	override initialize_slot => sub { 1 };
+	
+	override deinitialize_slot => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		return $ACCESSORS->delete($instance, $slot_name);
+	};
+	
+	override deinitialize_all_slots => sub {
+		my ($meta, $instance) = @_;
+		return $ACCESSORS->clear($instance);
+	};
+	
+	override is_slot_initialized => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		return $ACCESSORS->exists($instance, $slot_name);
+	};
+	
+	override weaken_slot_value => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		my $class = $meta->associated_metaclass;
+		confess "$class is implemented using Acme::MooseX::JSON, so cannot store weakened references.";
+	};
+	
+	override slot_value_is_weak => sub { 0 };
+	
+	override inline_create_instance => sub {
+		my ($meta, $klass) = @_;
+		qq{ bless \\(my \$json = '{}'), $klass }
+	};
+	
+	override inline_slot_access => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		qq{ '$ACCESSORS'->fetch($instance, '$slot_name') }
+	};
+	
+	override inline_get_slot_value => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		$meta->inline_slot_access($instance, $slot_name);
+	};
+	
+	override inline_set_slot_value => sub {
+		my ($meta, $instance, $slot_name, $value) = @_;
+		qq{ '$ACCESSORS'->store($instance, '$slot_name', $value) }
+	};
+	
+	override inline_deinitialize_slot => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		qq{ '$ACCESSORS'->delete($instance, '$slot_name') }
+	};
+	
+	override inline_is_slot_initialized => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		qq{ '$ACCESSORS'->exists($instance, '$slot_name') }
+	};
+	
+	override inline_weaken_slot_value => sub {
+		my ($meta, $instance, $slot_name) = @_;
+		my $class = $meta->associated_metaclass;
+		confess "$class is implemented using Acme::MooseX::JSON, so cannot store weakened references.";
+	};
+};
+
+Moose::Exporter->setup_import_methods(
+	also => [qw( Moose )],
+);
+ 
+sub init_meta
+{
+	shift;
+	my %p = @_;
+	Moose->init_meta(%p);
+	Moose::Util::MetaRole::apply_metaroles(
+		for             => $p{for_class},
+		class_metaroles => {
+			instance => [qw( Acme::MooseX::JSON::Trait::Instance )],
+			class    => [qw( Acme::MooseX::JSON::Trait::Class )],
+		},
+	);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Acme::MooseX::JSON - Moose objects that are internally blessed scalar refs containing JSON
+
+=head1 SYNOPSIS
+
+   {
+      package Local::Person;
+      use Acme::MooseX::JSON;
+      has name => (is => 'rw', isa => 'Str');
+   }
+   
+   my $object = Local::Person->new(name => "Bob");
+   print $$object;  # JSON
+
+=head1 DESCRIPTION
+
+This L<Moose> extension is akin to L<MooseX::InsideOut>, L<MooseX::GlobRef>
+and L<MooseX::ArrayRef> in that it allows you to create Moose classes where
+the instances aren't blessed hashes.
+
+However, unlike those fine modules, Acme::MooseX::JSON chooses just about
+the most insane way of implementing an instance's internals possible: they're
+serialized as a JSON string, which is then used as a blessed scalar reference.
+
+The use of JSON to serialize the object's internals places fairly strong
+restrictions on what kind of data can be held in the object's attributes.
+Strings, numbers and undef are all OK; arrayrefs and hashrefs are OK
+provided you don't create cyclical data structures, and provided they
+don't contain any non-OK data as values.
+
+=begin private
+
+=item init_meta
+
+=end private
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>.
+
+=head1 SEE ALSO
+
+L<Scalar::Accessors::LikeHash>.
+
+L<MooseX::InsideOut>, L<MooseX::GlobRef>, L<MooseX::ArrayRef>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

lib/Scalar/Accessors/LikeHash.pm

+package Scalar::Accessors::LikeHash;
+
+use 5.008;
+use strict;
+use warnings;
+
+use Carp qw(croak);
+use Role::Tiny;
+use Scalar::Util qw(blessed);
+
+our $AUTHORITY = 'cpan:TOBYINK';
+our $VERSION   = '0.001';
+
+requires qw( _to_hash _from_hash );
+
+sub new
+{
+	my $class = blessed($_[0]) ? ref(shift) : shift;
+	
+	croak "Class $class does not implement a constructor"
+		unless $class->does(__PACKAGE__);
+	
+	return bless(ref $_ ? \${$_} : \$_, $class)
+		for (@_, $class->_empty_structure);
+}
+
+sub _empty_structure
+{
+	my $class = shift;
+	$class->can('_from_hash')->(\(my $r), {});
+	return $r;
+}
+
+sub fetch
+{
+	my $invocant = shift;
+	my $ref      = (not ref $invocant) ? shift : $invocant;
+	$invocant    = __PACKAGE__ if ref $invocant && ! blessed $invocant;
+	
+	$invocant->can('_to_hash')->($ref)->{ $_[0] };
+}
+
+sub store
+{
+	my $invocant = shift;
+	my $ref      = (not ref $invocant) ? shift : $invocant;
+	$invocant    = __PACKAGE__ if ref $invocant && ! blessed $invocant;
+	
+	my $hash = $invocant->can('_to_hash')->($ref);
+	$hash->{ $_[0] } = $_[1];
+	$invocant->can('_from_hash')->($ref, $hash);
+	return;
+}
+
+sub exists
+{
+	my $invocant = shift;
+	my $ref      = (not ref $invocant) ? shift : $invocant;
+	$invocant    = __PACKAGE__ if ref $invocant && ! blessed $invocant;
+	
+	exists $invocant->can('_to_hash')->($ref)->{ $_[0] };
+}
+
+sub values
+{
+	my $invocant = shift;
+	my $ref      = (not ref $invocant) ? shift : $invocant;
+	$invocant    = __PACKAGE__ if ref $invocant && ! blessed $invocant;
+	
+	my $hash = $invocant->can('_to_hash')->($ref);
+	map { $hash->{$_} } sort keys %$hash;
+}
+
+sub keys
+{
+	my $invocant = shift;
+	my $ref      = (not ref $invocant) ? shift : $invocant;
+	$invocant    = __PACKAGE__ if ref $invocant && ! blessed $invocant;
+	
+	my $hash = $invocant->can('_to_hash')->($ref);
+	sort keys %$hash;
+}
+
+sub delete
+{
+	my $invocant = shift;
+	my $ref      = (not ref $invocant) ? shift : $invocant;
+	$invocant    = __PACKAGE__ if ref $invocant && ! blessed $invocant;
+	
+	my $hash = $invocant->can('_to_hash')->($ref);
+	my $r    = CORE::delete($hash->{ $_[0] });
+	$invocant->can('_from_hash')->($ref, $hash);
+	return $r;
+}
+
+sub clear
+{
+	my $invocant = shift;
+	my $ref      = (not ref $invocant) ? shift : $invocant;
+	$invocant    = __PACKAGE__ if ref $invocant && ! blessed $invocant;
+	
+	$$ref = $invocant->_empty_structure;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Scalar::Accessors::LikeHash - access a JSON/Sereal/etc scalar string in a hash-like manner
+
+=head1 SYNOPSIS
+
+   {
+      package Acme::Storable::Accessors;
+      
+      use Storable qw/ freeze thaw /;
+      
+      use Role::Tiny::With;
+      with 'Scalar::Accessors::LikeHash';
+      
+      sub _to_hash {
+         my ($ref) = @_;
+         thaw($$ref);
+      }
+      
+      sub _from_hash {
+         my ($ref, $hash) = @_;
+         $$ref = freeze($hash);
+      }
+   }
+   
+   my $string = File::Slurp::slurp("some-data.storable");
+   my $object = Acme::Storable::Accessors->new(\$string);
+   
+   $object->store(some_key => 42) unless $object->exists('some_key');
+   $object->fetch('some_key');
+   $object->delete('some_key');
+
+=head1 DESCRIPTION
+
+The idea of this is to treat a reference to a string as if it were a hash.
+You can store key-values pairs; fetch values using keys; delete keys; etc.
+This is slow and quite silly.
+
+This module is a role. Concrete implementations of the role need to provide
+C<< _from_hash >> and C<< _to_hash >> methods to serialize and deserialize
+a hashref to/from a scalarref.
+
+This role provides the following methods:
+
+=over
+
+=item C<< new(\$scalar) >>
+
+Yes, this role provides a constructor. Consumers can overide it.
+
+=item C<< fetch($key) >>
+
+=item C<< store($key, $value) >>
+
+=item C<< exists($key) >>
+
+=item C<< delete($key) >>
+
+=item C<< clear() >>
+
+Delete for each key.
+
+=item C<< keys() >>
+
+=item C<< values() >>
+
+=back
+
+These can be called as methods on a blessed scalar reference:
+
+	my $string = "{}";
+	bless \$string, "Scalar::Accessors::LikeHash::JSON";
+	$string->store(foo => 42);
+
+Or as class methods passing the scalar reference as an extra first argument:
+
+	my $string = "{}";
+	Scalar::Accessors::LikeHash::JSON->store(\$string, foo => 42);
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>.
+
+=head1 SEE ALSO
+
+For a more usable interface, see L<Tie::Hash::SerializedString>.
+
+For concrete implementations, see L<Scalar::Accessors::LikeHash::JSON>
+and L<Scalar::Accessors::LikeHash::Sereal>.
+
+For an insane usage of this concept, see L<Acme::MooseX::JSON>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

lib/Scalar/Accessors/LikeHash/JSON.pm

+package Scalar::Accessors::LikeHash::JSON;
+
+use 5.008;
+use strict;
+use warnings;
+
+our $AUTHORITY = 'cpan:TOBYINK';
+our $VERSION   = '0.001';
+
+use JSON;
+
+use Role::Tiny::With;
+with 'Scalar::Accessors::LikeHash';
+
+my ($j);
+
+sub _empty_structure
+{
+	q({});
+}
+
+sub _to_hash
+{
+	my ($ref) = @_;
+	($j ||= JSON::->new)->decode($$ref);
+}
+
+sub _from_hash
+{
+	my ($ref, $hash) = @_;
+	$$ref = ($j ||= JSON::->new)->encode($hash);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Scalar::Accessors::LikeHash::JSON - access a JSON scalar string in a hash-like manner
+
+=head1 SYNOPSIS
+
+   my $object = Scalar::Accessors::LikeHash::JSON->new;
+   
+   $object->store(some_key => 42) unless $object->exists('some_key');
+   $object->fetch('some_key');
+   $object->delete('some_key');
+   
+   # The object is internally a blessed scalarref containing JSON
+   print $$object; 
+
+=head1 DESCRIPTION
+
+This is a concrete implementation of L<Scalar::Accessors::LikeHash>.
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>.
+
+=head1 SEE ALSO
+
+L<Scalar::Accessors::LikeHash>,
+L<Acme::MooseX::JSON>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

lib/Scalar/Accessors/LikeHash/Sereal.pm

+package Scalar::Accessors::LikeHash::Sereal;
+
+use 5.008;
+use strict;
+use warnings;
+
+our $AUTHORITY = 'cpan:TOBYINK';
+our $VERSION   = '0.001';
+
+use Sereal;
+
+use Role::Tiny::With;
+with 'Scalar::Accessors::LikeHash';
+
+my ($e, $d);
+
+sub _to_hash
+{
+	my ($ref) = @_;
+	($d ||= Sereal::Decoder::->new)->decode($$ref);
+}
+
+sub _from_hash
+{
+	my ($ref, $hash) = @_;
+	$$ref = ($e ||= Sereal::Encoder::->new)->encode($hash);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Scalar::Accessors::LikeHash::Sereal - access a Sereal scalar string in a hash-like manner
+
+=head1 SYNOPSIS
+
+   my $object = Scalar::Accessors::LikeHash::Sereal->new;
+   
+   $object->store(some_key => 42) unless $object->exists('some_key');
+   $object->fetch('some_key');
+   $object->delete('some_key');
+   
+   # The object is internally a blessed scalarref containing Sereal
+   print $$object; 
+
+=head1 DESCRIPTION
+
+This is a concrete implementation of L<Scalar::Accessors::LikeHash>.
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>.
+
+=head1 SEE ALSO
+
+L<Scalar::Accessors::LikeHash>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

lib/Tie/Hash/SerializedString.pm

+package Tie::Hash::SerializedString;
+
+use 5.008;
+use strict;
+use warnings;
+
+our $AUTHORITY = 'cpan:TOBYINK';
+our $VERSION   = '0.001';
+
+use base "Tie::Hash";
+use Carp;
+use Module::Runtime;
+
+sub TIEHASH
+{
+	my $class = shift;
+	my ($ref, $implementation) = @_;
+	croak "need a scalar ref to tie hash to" unless ref $ref eq 'SCALAR';
+	$implementation = "Scalar::Accessors::LikeHash::JSON" unless defined $implementation;
+	Module::Runtime::use_package_optimistically($implementation);
+	bless [$implementation, $ref] => $class;
+}
+
+for my $method (qw( STORE FETCH EXISTS DELETE CLEAR ))
+{
+	my $lc_method = lc $method;
+	my $coderef = sub {
+		my ($implementation, $ref) = @{+shift};
+		return $implementation->$lc_method($ref, @_);
+	};
+	no strict 'refs';
+	*$method = $coderef;
+}
+
+sub FIRSTKEY
+{
+	my ($implementation, $ref) = @{+shift};
+	my @keys = $implementation->keys($ref);
+	return $keys[0];
+}
+
+sub NEXTKEY
+{
+	my ($implementation, $ref) = @{+shift};
+	my ($lastkey) = @_;
+	my @keys = $implementation->keys($ref);
+	while (@keys)
+	{
+		my $this = shift @keys;
+		return $keys[0] if $this eq $lastkey && @keys;
+	}
+	return;
+}
+
+sub SCALAR
+{
+	my ($implementation, $ref) = @{+shift};
+	return $$ref;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Tie::Hash::SerializedString - tied interface for Scalar::Accessors::LikeHash
+
+=head1 SYNOPSIS
+
+   my $string = '{}';
+   tie my %hash, "Tie::Hash::SerializedString", \$string;
+   
+   $hash{foo} = "bar";
+   
+   print $string;   # prints '{"foo":"bar"}'
+
+=head1 DESCRIPTION
+
+This provides a tied hash wrapper around L<Scalar::Accessors::LikeHash>
+implementations.
+
+Usage: C<< tie %hash, "Tie::Hash::SerializedString", \$scalar, $impl >>
+
+... where C<< $impl >> is the class name of a concrete implementation of the
+L<Scalar::Accessors::LikeHash> role. If the implementation is omitted, then
+defaults to L<Scalar::Accessors::LikeHash::JSON>.
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>.
+
+=head1 SEE ALSO
+
+L<Scalar::Accessors::LikeHash>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

meta/changes.pret

+# This file acts as the project's changelog.
+
+`Scalar-Accessors-LikeHash 0.001 cpan:TOBYINK`
+	issued  2013-02-08;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`Scalar-Accessors-LikeHash`
+	:programming-language "Perl" ;
+	:shortdesc            "access a JSON/Sereal/etc scalar string in a hash-like manner";
+	:homepage             <https://metacpan.org/release/Scalar-Accessors-LikeHash>;
+	:download-page        <https://metacpan.org/release/Scalar-Accessors-LikeHash>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>;
+	:created              2013-01-11;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`Scalar-Accessors-LikeHash`
+	perl_version_from m`Scalar::Accessors::LikeHash`;
+	version_from      m`Scalar::Accessors::LikeHash`;
+	readme_from       m`Scalar::Accessors::LikeHash`;
+	requires          p`Module::Runtime 0`;
+	requires          p`Role::Tiny 0`;
+	test_requires     p`Test::Requires 0`;
+	recommends        p`Moose 2.00`;
+	recommends        p`JSON 2.00`;
+	recommends        p`Sereal`;
+.
+
+# This file contains data about the project developers.
+
+@prefix : <http://xmlns.com/foaf/0.1/>.
+
+cpan:TOBYINK
+	:name  "Toby Inkster";
+	:mbox  <mailto:tobyink@cpan.org>.
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires 'JSON';
+
+use t::Accessors;
+
+my $class = 'Scalar::Accessors::LikeHash::JSON';
+
+subtest(
+	"Accessors provided by $class work as expected",
+	t::Accessors->checker($class),
+);
+
+my $j = $class->new;
+$j->store(xxx => [1,2,3]);
+is(
+	$$j,
+	'{"xxx":[1,2,3]}',
+	"$class stores its internals as correctly formatted JSON",
+);
+
+done_testing;
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires 'Sereal';
+
+use t::Accessors;
+
+my $class = 'Scalar::Accessors::LikeHash::Sereal';
+
+subtest(
+	"Accessors provided by $class work as expected",
+	t::Accessors->checker($class),
+);
+
+my $j = $class->new;
+$j->store(xxx => [1,2,3]);
+is(
+	$$j,
+	"=srl\x{0001}\x{0000}(*\x{0001}cxxx(+\x{0003}\x{0001}\x{0002}\x{0003}",
+	"$class stores its internals as correctly formatted Sereal",
+);
+
+done_testing;
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires qw/ JSON Moose /; # JSON first; faster failover
+
+{
+	package Local::Class;
+	use Acme::MooseX::JSON;
+	has aaa => (
+		is    => 'rw',
+		isa   => 'ArrayRef',
+	);
+}
+
+sub checker
+{
+	plan tests => 3;
+	my $o1 = Local::Class->new(aaa => [1,2,3]);
+	is($$o1, '{"aaa":[1,2,3]}', 'Object is internally JSON');
+	is_deeply($o1->aaa, [1,2,3]);
+	$o1->aaa([4,5,6]);
+	is_deeply($o1->aaa, [4,5,6]);
+}
+
+subtest "Mutable class" => \&checker;
+
+Local::Class->meta->make_immutable;
+subtest "Immutable class" => \&checker;
+
+done_testing;
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires qw/ JSON /;
+
+use Tie::Hash::SerializedString;
+
+my $str  = '{}';
+tie my %hash, 'Tie::Hash::SerializedString', \$str;
+
+$hash{foo} = "bar";
+is($str, '{"foo":"bar"}', 'tie mechanism seems to work');
+
+my $str2 = %hash;
+is($str2, '{"foo":"bar"}', '%hash in scalar context works');
+
+$hash{baz} = "quux";
+
+is_deeply(
+	[keys %hash],
+	[qw/ baz foo /],
+	'keys %hash',
+);
+
+is_deeply(
+	[values %hash],
+	[qw/ quux bar /],
+	'values %hash',
+);
+
+done_testing;
+use strict;
+use warnings;
+
+package t::Accessors;
+use Test::More;
+
+sub checker
+{
+	shift;
+	my $class = shift;
+	my $obj;
+	
+	return sub
+	{
+		plan tests => 11;
+		ok eval qq{ require $class };
+		
+		$obj = new_ok($class);
+		
+		can_ok($obj, qw( fetch store delete exists keys values ));
+		$obj->store(foo => 42);
+
+		is($obj->fetch('foo'), 42, 'fetch/store works');
+
+		$obj->store(bar => 99);
+		is_deeply([$obj->keys], [qw/bar foo/], 'keys works');
+		is_deeply([$obj->values], [qw/99 42/], 'values works');
+
+		ok($obj->exists('foo') && $obj->exists('bar') && !$obj->exists('baz'), 'exists works');
+
+		is($obj->delete('foo'), 42, 'delete returns correct value');
+		ok($obj->exists('bar') && !$obj->exists('foo'), 'delete modifies structure');
+
+		$obj->clear;
+		is_deeply([$obj->keys], [], 'clear works');
+
+		$obj->store(xxx => [1..3]);
+		is($obj->fetch('xxx')->[1], 2, 'nested structures stored correctly');
+	};
+}
+
+1;
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use XT::Util;
+use Test::More;
+use Test::Pod::Coverage;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pod_coverage_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pod_coverage_ok();
+}
+

xt/03meta_uptodate.config

+{"package":"Scalar-Accessors-LikeHash"}
+

xt/03meta_uptodate.t

+use XT::Util;
+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok(__CONFIG__->{package}, __CONFIG__->{version_from});
+
+use Test::EOL;
+all_perl_files_ok();
+use Test::Tabs;
+all_perl_files_ok();
+use XT::Util;
+use Test::More;
+use Test::HasVersion;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pm_version_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pm_version_ok();
+}
+