--- /dev/null
+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;
+
--- /dev/null
+Revision history for Perl extension MooseX-AttributeHelpers
+
+0.01
+ - module released to CPAN
\ No newline at end of file
--- /dev/null
+^_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
--- /dev/null
+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.
+
--- /dev/null
+
+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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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
--- /dev/null
+
+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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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
--- /dev/null
+
+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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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
--- /dev/null
+
+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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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
--- /dev/null
+
+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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+
+BEGIN {
+ use_ok('MooseX::AttributeHelpers');
+}
\ No newline at end of file
--- /dev/null
+#!/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');
+
+
+
--- /dev/null
+#!/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');
+
+
+
--- /dev/null
+#!/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();
--- /dev/null
+#!/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();
projects / gitmo/MooseX-AttributeHelpers.git / commitdiff