--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 51;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('MooseX::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+
+ has 'options' => (
+ traits => [qw/Collection::Array/],
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ default => sub { [] },
+ provides => {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ 'shift' => 'remove_first_option',
+ 'unshift' => 'insert_options',
+ 'get' => 'get_option_at',
+ 'set' => 'set_option_at',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'clear' => 'clear_options',
+ }
+ );
+}
+
+my $stuff = Stuff->new(options => [ 10, 12 ]);
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ add_options
+ remove_last_option
+ remove_first_option
+ insert_options
+ get_option_at
+ set_option_at
+ num_options
+ clear_options
+ has_options
+];
+
+is_deeply($stuff->options, [10, 12], '... got options');
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 2, '... got 2 options');
+
+is($stuff->remove_last_option, 12, '... removed the last option');
+is($stuff->remove_first_option, 10, '... removed the last option');
+
+is_deeply($stuff->options, [], '... no options anymore');
+
+ok(!$stuff->has_options, '... no options');
+is($stuff->num_options, 0, '... got no options');
+
+lives_ok {
+ $stuff->add_options(1, 2, 3);
+} '... set the option okay';
+
+is_deeply($stuff->options, [1, 2, 3], '... got options now');
+
+ok($stuff->has_options, '... no options');
+is($stuff->num_options, 3, '... got 3 options');
+
+is($stuff->get_option_at(0), 1, '... get option at index 0');
+is($stuff->get_option_at(1), 2, '... get option at index 1');
+is($stuff->get_option_at(2), 3, '... get option at index 2');
+
+lives_ok {
+ $stuff->set_option_at(1, 100);
+} '... set the option okay';
+
+is($stuff->get_option_at(1), 100, '... get option at index 1');
+
+lives_ok {
+ $stuff->add_options(10, 15);
+} '... set the option okay';
+
+is_deeply($stuff->options, [1, 100, 3, 10, 15], '... got more options now');
+
+is($stuff->num_options, 5, '... got 5 options');
+
+is($stuff->remove_last_option, 15, '... removed the last option');
+
+is($stuff->num_options, 4, '... got 4 options');
+is_deeply($stuff->options, [1, 100, 3, 10], '... got diff options now');
+
+lives_ok {
+ $stuff->insert_options(10, 20);
+} '... set the option okay';
+
+is($stuff->num_options, 6, '... got 6 options');
+is_deeply($stuff->options, [10, 20, 1, 100, 3, 10], '... got diff options now');
+
+is($stuff->get_option_at(0), 10, '... get option at index 0');
+is($stuff->get_option_at(1), 20, '... get option at index 1');
+is($stuff->get_option_at(3), 100, '... get option at index 3');
+
+is($stuff->remove_first_option, 10, '... getting the first option');
+
+is($stuff->num_options, 5, '... got 5 options');
+is($stuff->get_option_at(0), 20, '... get option at index 0');
+
+$stuff->clear_options;
+is_deeply( $stuff->options, [], "... clear options" );
+
+## check some errors
+
+dies_ok {
+ $stuff->add_options([]);
+} '... could not add an array ref where an int is expected';
+
+dies_ok {
+ $stuff->insert_options(undef);
+} '... could not add an undef where an int is expected';
+
+dies_ok {
+ $stuff->set_option(5, {});
+} '... could not add a hash ref where an int is expected';
+
+dies_ok {
+ Stuff->new(options => [ 'Foo', 10, 'Bar', 20 ]);
+} '... bad constructor params';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::Array');
+
+is_deeply($options->provides, {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ 'shift' => 'remove_first_option',
+ 'unshift' => 'insert_options',
+ 'get' => 'get_option_at',
+ 'set' => 'set_option_at',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'clear' => 'clear_options',
+}, '... got the right provies mapping');
+
+is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 35;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('MooseX::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+ use MooseX::AttributeHelpers;
+
+ has 'options' => (
+ traits => [qw/Collection::Hash/],
+ is => 'ro',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ provides => {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+ }
+ );
+}
+
+my $stuff = Stuff->new();
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ set_option
+ get_option
+ has_options
+ num_options
+ delete_option
+ clear_options
+];
+
+ok(!$stuff->has_options, '... we have no options');
+is($stuff->num_options, 0, '... we have no options');
+
+is_deeply($stuff->options, {}, '... no options yet');
+
+lives_ok {
+ $stuff->set_option(foo => 'bar');
+} '... set the option okay';
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 1, '... we have 1 option(s)');
+is_deeply($stuff->options, { foo => 'bar' }, '... got options now');
+
+lives_ok {
+ $stuff->set_option(bar => 'baz');
+} '... set the option okay';
+
+is($stuff->num_options, 2, '... we have 2 option(s)');
+is_deeply($stuff->options, { foo => 'bar', bar => 'baz' }, '... got more options now');
+
+is($stuff->get_option('foo'), 'bar', '... got the right option');
+
+is_deeply([ $stuff->get_option(qw(foo bar)) ], [qw(bar baz)], "get multiple options at once");
+
+lives_ok {
+ $stuff->set_option(oink => "blah", xxy => "flop");
+} '... set the option okay';
+
+is($stuff->num_options, 4, "4 options");
+is_deeply([ $stuff->get_option(qw(foo bar oink xxy)) ], [qw(bar baz blah flop)], "get multiple options at once");
+
+lives_ok {
+ $stuff->delete_option('bar');
+} '... deleted the option okay';
+
+lives_ok {
+ $stuff->delete_option('oink');
+} '... deleted the option okay';
+
+lives_ok {
+ $stuff->delete_option('xxy');
+} '... deleted the option okay';
+
+is($stuff->num_options, 1, '... we have 1 option(s)');
+is_deeply($stuff->options, { foo => 'bar' }, '... got more options now');
+
+$stuff->clear_options;
+
+is_deeply($stuff->options, { }, "... cleared options" );
+
+lives_ok {
+ Stuff->new(options => { foo => 'BAR' });
+} '... good constructor params';
+
+## check some errors
+
+dies_ok {
+ $stuff->set_option(bar => {});
+} '... could not add a hash ref where an string is expected';
+
+dies_ok {
+ Stuff->new(options => { foo => [] });
+} '... bad constructor params';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::Hash');
+
+is_deeply($options->provides, {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+}, '... got the right provies mapping');
+
+is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+use Test::Moose;
+
+BEGIN {
+ use_ok('MooseX::AttributeHelpers');
+}
+
+{
+ package Real;
+ use Moose;
+
+ has 'integer' => (
+ traits => [qw/Number/],
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 5 },
+ provides => {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+ }
+ );
+}
+
+my $real = Real->new;
+isa_ok($real, 'Real');
+
+can_ok($real, $_) for qw[
+ set add sub mul div mod abs
+];
+
+is $real->integer, 5, 'Default to five';
+
+$real->add(10);
+
+is $real->integer, 15, 'Add ten for fithteen';
+
+$real->sub(3);
+
+is $real->integer, 12, 'Subtract three for 12';
+
+$real->set(10);
+
+is $real->integer, 10, 'Set to ten';
+
+$real->div(2);
+
+is $real->integer, 5, 'divide by 2';
+
+$real->mul(2);
+
+is $real->integer, 10, 'multiplied by 2';
+
+$real->mod(2);
+
+is $real->integer, 0, 'Mod by 2';
+
+$real->set(7);
+
+$real->mod(5);
+
+is $real->integer, 2, 'Mod by 5';
+
+$real->set(-1);
+
+$real->abs;
+
+is $real->integer, 1, 'abs 1';
+
+## test the meta
+
+my $attr = $real->meta->get_attribute('integer');
+does_ok($attr, 'MooseX::AttributeHelpers::Trait::Number');
+
+is_deeply($attr->provides, {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+}, '... got the right provides mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 21;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('MooseX::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+
+ has '_options' => (
+ traits => [qw/Collection::List/],
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ init_arg => 'options',
+ default => sub { [] },
+ provides => {
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'map' => 'map_options',
+ 'grep' => 'filter_options',
+ 'find' => 'find_option',
+ 'elements' => 'options',
+ 'join' => 'join_options',
+ }
+ );
+}
+
+my $stuff = Stuff->new(options => [ 1 .. 10 ]);
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ _options
+ num_options
+ has_options
+ map_options
+ filter_options
+ find_option
+ options
+ join_options
+];
+
+is_deeply($stuff->_options, [1 .. 10], '... got options');
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 10, '... got 2 options');
+
+is_deeply(
+[ $stuff->filter_options(sub { $_[0] % 2 == 0 }) ],
+[ 2, 4, 6, 8, 10 ],
+'... got the right filtered values'
+);
+
+is_deeply(
+[ $stuff->map_options(sub { $_[0] * 2 }) ],
+[ 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 ],
+'... got the right mapped values'
+);
+
+is($stuff->find_option(sub { $_[0] % 2 == 0 }), 2, '.. found the right option');
+
+is_deeply([ $stuff->options ], [1 .. 10], '... got the list of options');
+
+is($stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10', '... joined the list of options by :');
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('_options');
+does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::List');
+
+is_deeply($options->provides, {
+ 'map' => 'map_options',
+ 'grep' => 'filter_options',
+ 'find' => 'find_option',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'elements' => 'options',
+ 'join' => 'join_options',
+}, '... got the right provies mapping');
+
+is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('MooseX::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+ use MooseX::AttributeHelpers;
+
+ has 'word_histogram' => (
+ traits => [qw/Collection::Bag/],
+ is => 'ro',
+ provides => {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+ }
+ );
+}
+
+my $stuff = Stuff->new();
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ add_word
+ get_count_for
+ has_any_words
+ num_words
+ delete_word
+];
+
+ok(!$stuff->has_any_words, '... we have no words');
+is($stuff->num_words, 0, '... we have no words');
+
+lives_ok {
+ $stuff->add_word('bar');
+} '... set the words okay';
+
+ok($stuff->has_any_words, '... we have words');
+is($stuff->num_words, 1, '... we have 1 word(s)');
+is($stuff->get_count_for('bar'), 1, '... got words now');
+
+lives_ok {
+ $stuff->add_word('foo');
+ $stuff->add_word('bar') for 0 .. 3;
+ $stuff->add_word('baz') for 0 .. 10;
+} '... set the words okay';
+
+is($stuff->num_words, 3, '... we still have 1 word(s)');
+is($stuff->get_count_for('foo'), 1, '... got words now');
+is($stuff->get_count_for('bar'), 5, '... got words now');
+is($stuff->get_count_for('baz'), 11, '... got words now');
+
+## test the meta
+
+my $words = $stuff->meta->get_attribute('word_histogram');
+does_ok($words, 'MooseX::AttributeHelpers::Trait::Collection::Bag');
+
+is_deeply($words->provides, {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+}, '... got the right provides mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 17;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('MooseX::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'string' => (
+ traits => [qw/String/],
+ is => 'rw',
+ isa => 'Str',
+ default => sub { '' },
+ provides => {
+ inc => 'inc_string',
+ append => 'append_string',
+ prepend => 'prepend_string',
+ match => 'match_string',
+ replace => 'replace_string',
+ chop => 'chop_string',
+ chomp => 'chomp_string',
+ clear => 'clear_string',
+ }
+ );
+}
+
+my $page = MyHomePage->new();
+isa_ok($page, 'MyHomePage');
+
+is($page->string, '', '... got the default value');
+
+$page->string('a');
+
+$page->inc_string;
+is($page->string, 'b', '... got the incremented value');
+
+$page->inc_string;
+is($page->string, 'c', '... got the incremented value (again)');
+
+$page->append_string("foo$/");
+is($page->string, "cfoo$/", 'appended to string');
+
+$page->chomp_string;
+is($page->string, "cfoo", 'chomped string');
+
+$page->chomp_string;
+is($page->string, "cfoo", 'chomped is noop');
+
+$page->chop_string;
+is($page->string, "cfo", 'chopped string');
+
+$page->prepend_string("bar");
+is($page->string, 'barcfo', 'prepended to string');
+
+is_deeply( [ $page->match_string(qr/([ao])/) ], [ "a" ], "match" );
+
+$page->replace_string(qr/([ao])/, sub { uc($1) });
+is($page->string, 'bArcfo', "substitution");
+
+$page->clear_string;
+is($page->string, '', "clear");
+
+# check the meta ..
+
+my $string = $page->meta->get_attribute('string');
+does_ok($string, 'MooseX::AttributeHelpers::Trait::String');
+
+is($string->helper_type, 'Str', '... got the expected helper type');
+
+is($string->type_constraint->name, 'Str', '... got the expected type constraint');
+
+is_deeply($string->provides, {
+ inc => 'inc_string',
+ append => 'append_string',
+ prepend => 'prepend_string',
+ match => 'match_string',
+ replace => 'replace_string',
+ chop => 'chop_string',
+ chomp => 'chomp_string',
+ clear => 'clear_string',
+}, '... got the right provides methods');
+
projects / gitmo/MooseX-AttributeHelpers.git / commitdiff