Toby Inkster avatar Toby Inkster committed 5a69c3a

initial MooX::Struct work

Comments (0)

Files changed (15)

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

lib/MooX/Struct.pm

+package MooX::Struct;
+
+use 5.008;
+use strict;
+use warnings;
+use utf8;
+
+BEGIN {
+	$MooX::Struct::AUTHORITY = 'cpan:TOBYINK';
+	$MooX::Struct::VERSION   = '0.001';
+}
+
+use Moo             1.000000;
+use Data::OptList   0         qw();
+use Sub::Install    0         qw();
+use Scalar::Does    0         qw( does );
+use Object::ID      0         qw( object_id );
+
+my $counter = 0;
+my $generate_class_name = sub
+{
+	return sprintf('%s::__ANON__::%04d', __PACKAGE__, ++$counter);
+};
+
+sub import
+{
+	my $caller = caller;
+	my $me     = shift;
+	my @args   = @{ Data::OptList::mkopt(\@_) };
+	
+	foreach my $arg (@args)
+	{
+		my ($subname, $class) = @$arg;
+		$class = [] unless defined $class;
+		
+		Sub::Install::install_sub {
+			into   => $caller,
+			as     => $subname,
+			code   => sub ()
+			{
+				if (ref $class) # inflate!
+				{
+					my @attrs = @{ Data::OptList::mkopt($class) };
+					$class = $generate_class_name->();
+					Moo->_set_superclasses($class, __PACKAGE__);
+					Moo->_maybe_reset_handlemoose($class);
+					foreach my $attr (@attrs)
+					{
+						my ($name, $val) = @$attr;
+						if (does $val, 'CODE')
+						{
+							Sub::Install::install_sub {
+								into   => $class,
+								as     => $name,
+								code   => $val,
+							};
+						}
+						else
+						{
+							my %spec = (
+								is => 'ro',
+								( does($val, 'ARRAY')
+									? @$val
+									: ( does($val,'HASH') ? %$val : () )
+								),
+							);
+							Moo->_constructor_maker_for($class)
+								->register_attribute_specs($name, \%spec);
+							Moo->_accessor_maker_for($class)
+								->generate_method($class, $name, \%spec);
+							Moo->_maybe_reset_handlemoose($class);
+						}
+					}
+				}
+				return $class;
+			},
+		};
+	}
+}
+
+no Moo;
+
+1;
+
+__END__
+
+=head1 NAME
+
+MooX::Struct - make simple lightweight record-like structures that make sounds like cows
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=MooX-Struct>.
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 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.
+
+`MooX-Struct 0.001 cpan:TOBYINK`
+	issued  2012-10-04;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`MooX-Struct`
+	:programming-language "Perl" ;
+	:shortdesc            "make simple lightweight record-like structures that make sounds like cows";
+	:homepage             <https://metacpan.org/release/MooX-Struct>;
+	:download-page        <https://metacpan.org/release/MooX-Struct>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=MooX-Struct>;
+	:created              2012-10-04;
+	: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.
+
+`MooX-Struct`
+	perl_version_from m`MooX::Struct`;
+	version_from      m`MooX::Struct`;
+	readme_from       m`MooX::Struct`;
+	test_requires     p`Test::More 0.61` ;
+	.
+
+# 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 Test::More tests => 1;
+BEGIN { use_ok('MooX::Struct') };
+
+use strict;
+use Test::More tests => 12;
+use MooX::Struct
+	Organisation => [qw/ name employees /, company_number => [is => 'rw']],
+	Person       => [qw/ name /];
+
+my $alice = Person->new(name => 'Alice');
+my $bob   = Person->new(name => 'Bob');
+my $acme  = Organisation->new(name => 'ACME', employees => [$alice, $bob]);
+
+note sprintf("Person class:        %s", Person);
+note sprintf("Organisation class:  %s", Organisation);
+
+is(
+	ref($alice),
+	ref($bob),
+	'Alice and Bob are in the same class',
+);
+
+isnt(
+	ref($alice),
+	ref($acme),
+	'Alice and ACME are not in the same class',
+);
+
+isa_ok($_, 'MooX::Struct', '$'.lc($_->name)) for ($alice, $bob, $acme);
+
+is($alice->name, 'Alice', '$alice is called Alice');
+is($bob->name, 'Bob', '$bob is called Bob');
+is($acme->name, 'ACME', '$acme is called ACME');
+
+ok !eval {
+	$acme->name('Acme Inc'); 1
+}, 'accessors are read-only by default';
+
+$acme->company_number(12345);
+is($acme->company_number, 12345, 'accessors can be made read-write');
+
+can_ok $alice => 'object_id';
+isnt($alice->object_id, $bob->object_id, 'object_id is unique identifier');
+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":"MooX-Struct"}
+

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();
+}
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.