From: Stevan Little Date: Fri, 6 Apr 2007 04:42:26 +0000 (+0000) Subject: adding MooseX::ATtributeHelpers X-Git-Tag: 0.18_01~93 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=22d869ff05be971ebf7b672c8f9cbec6151e8d82;p=gitmo%2FMooseX-AttributeHelpers.git adding MooseX::ATtributeHelpers --- 22d869ff05be971ebf7b672c8f9cbec6151e8d82 diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..f887a07 --- /dev/null +++ b/Build.PL @@ -0,0 +1,25 @@ +use Module::Build; + +use strict; + +my $build = Module::Build->new( + module_name => 'MooseX::AttributeHelpers', + license => 'perl', + requires => { + 'Moose' => '0.19', + }, + optional => { + }, + build_requires => { + 'Test::More' => '0.62', + 'Test::Exception' => '0.21', + }, + create_makefile_pl => 'traditional', + recursive_test_files => 1, + add_to_cleanup => [ + 'META.yml', '*.bak', '*.gz', 'Makefile.PL', + ], +); + +$build->create_build_script; + diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..985e931 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,4 @@ +Revision history for Perl extension MooseX-AttributeHelpers + +0.01 + - module released to CPAN \ No newline at end of file diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..e69de29 diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..3de3ebc --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,19 @@ +^_build +^Build$ +^blib +~$ +\.bak$ +^MANIFEST\.SKIP$ +CVS +\.svn +\.DS_Store +cover_db +\..*\.sw.?$ +^Makefile$ +^pm_to_blib$ +^MakeMaker-\d +^blibdirs$ +\.old$ +^#.*#$ +^\.# +^TODO$ \ No newline at end of file diff --git a/README b/README new file mode 100644 index 0000000..ec7022a --- /dev/null +++ b/README @@ -0,0 +1,29 @@ +MooseX::AttributeHelpers version 0.01 +=========================== + +See the individual module documentation for more information + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + Moose + +COPYRIGHT AND LICENCE + +Copyright (C) 2007 Infinity Interactive, Inc. + +http://www.iinteractive.com + +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/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm new file mode 100644 index 0000000..31370bb --- /dev/null +++ b/lib/MooseX/AttributeHelpers.pm @@ -0,0 +1,44 @@ + +package MooseX::AttributeHelpers; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::Counter; +use MooseX::AttributeHelpers::Collection::Array; +use MooseX::AttributeHelpers::Collection::Hash; + +1; + +__END__ + +=pod + +=head1 NAME + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=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@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 \ No newline at end of file diff --git a/lib/MooseX/AttributeHelpers/Collection.pm b/lib/MooseX/AttributeHelpers/Collection.pm new file mode 100644 index 0000000..392cd92 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Collection.pm @@ -0,0 +1,40 @@ + +package MooseX::AttributeHelpers::Collection; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +1; + +__END__ + +=pod + +=head1 NAME + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=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@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 \ No newline at end of file diff --git a/lib/MooseX/AttributeHelpers/Collection/Array.pm b/lib/MooseX/AttributeHelpers/Collection/Array.pm new file mode 100644 index 0000000..fc46ebb --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Collection/Array.pm @@ -0,0 +1,136 @@ + +package MooseX::AttributeHelpers::Collection::Array; +use Moose; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'Moose::Meta::Attribute'; + +my %METHOD_CONSTRUCTORS = ( + 'push' => sub { + my $attr = shift; + return sub { + my $instance = shift; + push @{$attr->get_value($instance)} => @_; + }; + }, + 'pop' => sub { + my $attr = shift; + return sub { pop @{$attr->get_value($_[0])} }; + }, + 'unshift' => sub { + my $attr = shift; + return sub { + my $instance = shift; + unshift @{$attr->get_value($instance)} => @_; + }; + }, + 'shift' => sub { + my $attr = shift; + return sub { shift @{$attr->get_value($_[0])} }; + }, + 'get' => sub { + my $attr = shift; + return sub { $attr->get_value($_[0])->[$_[1]] }; + }, + 'set' => sub { + my $attr = shift; + return sub { $attr->get_value($_[0])->[$_[1]] = $_[2] }; + }, +); + +has 'provides' => ( + is => 'ro', + isa => subtype('HashRef' => where { + (exists $METHOD_CONSTRUCTORS{$_} || return) for keys %{$_}; 1; + }), + required => 1, +); + +has '+$!default' => (required => 1); +has '+type_constraint' => (required => 1); + +before '_process_options' => sub { + my ($self, %options) = @_; + + if (exists $options{provides}) { + (exists $options{isa}) + || confess "You must define a type with the Array metaclass"; + + (find_type_constraint($options{isa})->is_subtype_of('ArrayRef')) + || confess "The type constraint for a Array must be a subtype of ArrayRef"; + } +}; + +after 'install_accessors' => sub { + my $attr = shift; + my $class = $attr->associated_class; + + foreach my $key (keys %{$attr->provides}) { + (exists $METHOD_CONSTRUCTORS{$key}) + || confess "Unsupported method type ($key)"; + $class->add_method( + $attr->provides->{$key}, + $METHOD_CONSTRUCTORS{$key}->($attr) + ); + } +}; + +no Moose; +no Moose::Util::TypeConstraints; + +# register the alias ... +package Moose::Meta::Attribute::Custom::Collection; +sub register_implementation { 'MooseX::AttributeHelpers::Collection::Array' } + + +1; + +__END__ + +=pod + +=head1 NAME + +=head1 SYNOPSIS + + package Stuff; + use Moose; + + has 'options' => ( + metaclass => 'Collection', + is => 'ro', + isa => 'ArrayRef', + default => sub { [] }, + provides => { + 'push' => 'add_options', + 'pop' => 'remove_last_option', + } + ); + +=head1 DESCRIPTION + +=head1 METHODS + +=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@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 \ No newline at end of file diff --git a/lib/MooseX/AttributeHelpers/Collection/Hash.pm b/lib/MooseX/AttributeHelpers/Collection/Hash.pm new file mode 100644 index 0000000..fa52a76 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Collection/Hash.pm @@ -0,0 +1,40 @@ + +package MooseX::AttributeHelpers::Collection::Hash; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +1; + +__END__ + +=pod + +=head1 NAME + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=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@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 \ No newline at end of file diff --git a/lib/MooseX/AttributeHelpers/Counter.pm b/lib/MooseX/AttributeHelpers/Counter.pm new file mode 100644 index 0000000..3bce3b0 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Counter.pm @@ -0,0 +1,117 @@ + +package MooseX::AttributeHelpers::Counter; +use Moose; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'Moose::Meta::Attribute'; + +my %METHOD_CONSTRUCTORS = ( + inc => sub { + my $attr = shift; + return sub { $attr->set_value($_[0], $attr->get_value($_[0]) + 1) }; + }, + dec => sub { + my $attr = shift; + return sub { $attr->set_value($_[0], $attr->get_value($_[0]) - 1) }; + }, +); + +has 'provides' => ( + is => 'ro', + isa => subtype('HashRef' => where { + (exists $METHOD_CONSTRUCTORS{$_} || return) for keys %{$_}; 1; + }), + required => 1, +); + +has '+$!default' => (required => 1); +has '+type_constraint' => (required => 1); + +before '_process_options' => sub { + my ($self, %options) = @_; + + if (exists $options{provides}) { + (exists $options{isa}) + || confess "You must define a type with the Counter metaclass"; + + (find_type_constraint($options{isa})->is_subtype_of('Num')) + || confess "The type constraint for a Counter must be a subtype of Num"; + } +}; + +after 'install_accessors' => sub { + my $attr = shift; + my $class = $attr->associated_class; + + foreach my $key (keys %{$attr->provides}) { + (exists $METHOD_CONSTRUCTORS{$key}) + || confess "Unsupported method type ($key)"; + $class->add_method( + $attr->provides->{$key}, + $METHOD_CONSTRUCTORS{$key}->($attr) + ); + } +}; + +no Moose; +no Moose::Util::TypeConstraints; + +# register the alias ... +package Moose::Meta::Attribute::Custom::Counter; +sub register_implementation { 'MooseX::AttributeHelpers::Counter' } + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Counter + +=head1 SYNOPSIS + + package MyHomePage; + use Moose; + + has 'counter' => ( + metaclass => 'Counter', + is => 'rw', + isa => 'Int', + default => sub { 0 }, + provides => { + inc => 'inc_counter', + } + ); + + my $page = MyHomePage->new(); + $page->inc_counter; # same as $page->counter($page->counter + 1); + +=head1 DESCRIPTION + +=head1 METHODS + +=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@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 \ No newline at end of file diff --git a/t/000_load.t b/t/000_load.t new file mode 100644 index 0000000..e62e167 --- /dev/null +++ b/t/000_load.t @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More no_plan => 1; + +BEGIN { + use_ok('MooseX::AttributeHelpers'); +} \ No newline at end of file diff --git a/t/001_basic_counter.t b/t/001_basic_counter.t new file mode 100644 index 0000000..107314f --- /dev/null +++ b/t/001_basic_counter.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More no_plan => 1; + +BEGIN { + use_ok('MooseX::AttributeHelpers'); +} + +{ + package MyHomePage; + use Moose; + + has 'counter' => ( + metaclass => 'Counter', + is => 'ro', + isa => 'Int', + default => sub { 0 }, + provides => { + inc => 'inc_counter', + dec => 'dec_counter', + } + ); +} + +my $page = MyHomePage->new(); +isa_ok($page, 'MyHomePage'); + +is($page->counter, 0, '... got the default value'); + +$page->inc_counter; +is($page->counter, 1, '... got the incremented value'); + +$page->inc_counter; +is($page->counter, 2, '... got the incremented value (again)'); + +$page->dec_counter; +is($page->counter, 1, '... got the decremented value'); + + + diff --git a/t/002_basic_collection.t b/t/002_basic_collection.t new file mode 100644 index 0000000..b785864 --- /dev/null +++ b/t/002_basic_collection.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More no_plan => 1; + +BEGIN { + use_ok('MooseX::AttributeHelpers'); +} + +{ + package Stuff; + use Moose; + + has 'options' => ( + metaclass => 'Collection', + is => 'ro', + isa => 'ArrayRef', + default => sub { [] }, + provides => { + 'push' => 'add_options', + 'pop' => 'remove_last_option', + } + ); +} + +my $stuff = Stuff->new(); +isa_ok($stuff, 'Stuff'); + +is_deeply($stuff->options, [], '... no options yet'); + +$stuff->add_options(1, 2, 3); +is_deeply($stuff->options, [1, 2, 3], '... got options now'); + +$stuff->add_options(10, 15); +is_deeply($stuff->options, [1, 2, 3, 10, 15], '... got more options now'); + +is($stuff->remove_last_option, 15, '... removed the last option'); + +is_deeply($stuff->options, [1, 2, 3, 10], '... got diff options now'); + + + diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..4ae1af3 --- /dev/null +++ b/t/pod.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +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(); diff --git a/t/pod_coverage.t b/t/pod_coverage.t new file mode 100644 index 0000000..7569358 --- /dev/null +++ b/t/pod_coverage.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +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();