From 120cfbbb0a4e7115670c90e35688d94b8597ab6e Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Wed, 9 Nov 2011 16:34:42 +0000 Subject: split! tags, ranges, both, now separate classes --- Data-MultiValued/lib/Data/MultiValued.pm | 54 --------- Data-MultiValued/lib/Data/MultiValued/Ranges.pm | 50 ++++++++ Data-MultiValued/lib/Data/MultiValued/Tags.pm | 49 ++++++++ .../lib/Data/MultiValued/TagsAndRanges.pm | 54 +++++++++ Data-MultiValued/t/more-overlapping-ranges.t | 126 ++++++++++++--------- Data-MultiValued/t/overlapping-ranges.t | 94 ++++++++------- Data-MultiValued/t/ranges-setting.t | 122 +++++++++++--------- Data-MultiValued/t/simple-setting.t | 46 ++++++-- Data-MultiValued/t/tags-ranges-setting.t | 4 +- Data-MultiValued/t/tags-setting.t | 86 ++++++++------ 10 files changed, 436 insertions(+), 249 deletions(-) delete mode 100644 Data-MultiValued/lib/Data/MultiValued.pm create mode 100644 Data-MultiValued/lib/Data/MultiValued/Ranges.pm create mode 100644 Data-MultiValued/lib/Data/MultiValued/Tags.pm create mode 100644 Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm diff --git a/Data-MultiValued/lib/Data/MultiValued.pm b/Data-MultiValued/lib/Data/MultiValued.pm deleted file mode 100644 index 65b041d..0000000 --- a/Data-MultiValued/lib/Data/MultiValued.pm +++ /dev/null @@ -1,54 +0,0 @@ -package Data::MultiValued; -use Moose; -use MooseX::Params::Validate; -use Moose::Util::TypeConstraints; -use MooseX::Types::Moose qw(Num Str Undef Any); -use Data::MultiValued::Exceptions; -use Data::MultiValued::TagContainerForRanges; - -# ABSTRACT: Handle values with tags and validity ranges - -has _storage => ( - is => 'rw', - isa => class_type('Data::MultiValued::TagContainerForRanges'), - init_arg => undef, - lazy_build => 1, -); - -sub _build__storage { - Data::MultiValued::TagContainerForRanges->new(); -} - -sub set { - my ($self,%args) = validated_hash( - \@_, - from => { isa => Num|Undef, optional => 1, }, - to => { isa => Num|Undef, optional => 1, }, - tag => { isa => Str, optional => 1, }, - value => { isa => Any, }, - ); - - $self->_storage->get_or_create(\%args) - ->set_or_create(\%args) - ->{value} = $args{value}; -} - -sub get { - my ($self,%args) = validated_hash( - \@_, - at => { isa => Num|Undef, optional => 1, }, - tag => { isa => Str, optional => 1, }, - ); - - $self->_storage->get(\%args) - ->get(\%args) - ->{value}; -} - -sub clear { - my ($self) = @_; - - $self->_clear_storage; -} - -1; diff --git a/Data-MultiValued/lib/Data/MultiValued/Ranges.pm b/Data-MultiValued/lib/Data/MultiValued/Ranges.pm new file mode 100644 index 0000000..b2acdd4 --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued/Ranges.pm @@ -0,0 +1,50 @@ +package Data::MultiValued::Ranges; +use Moose; +use MooseX::Params::Validate; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(Num Str Undef Any); +use Data::MultiValued::Exceptions; +use Data::MultiValued::RangeContainer; + +# ABSTRACT: Handle values with tags and validity ranges + +has _storage => ( + is => 'rw', + isa => class_type('Data::MultiValued::RangeContainer'), + init_arg => undef, + lazy_build => 1, +); + +sub _build__storage { + Data::MultiValued::RangeContainer->new(); +} + +sub set { + my ($self,%args) = validated_hash( + \@_, + from => { isa => Num|Undef, optional => 1, }, + to => { isa => Num|Undef, optional => 1, }, + value => { isa => Any, }, + ); + + $self->_storage->set_or_create(\%args) + ->{value} = $args{value}; +} + +sub get { + my ($self,%args) = validated_hash( + \@_, + at => { isa => Num|Undef, optional => 1, }, + ); + + $self->_storage->get(\%args) + ->{value}; +} + +sub clear { + my ($self) = @_; + + $self->_clear_storage; +} + +1; diff --git a/Data-MultiValued/lib/Data/MultiValued/Tags.pm b/Data-MultiValued/lib/Data/MultiValued/Tags.pm new file mode 100644 index 0000000..0325f61 --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued/Tags.pm @@ -0,0 +1,49 @@ +package Data::MultiValued::Tags; +use Moose; +use MooseX::Params::Validate; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(Num Str Undef Any); +use Data::MultiValued::Exceptions; +use Data::MultiValued::TagContainer; + +# ABSTRACT: Handle values with tags and validity ranges + +has _storage => ( + is => 'rw', + isa => class_type('Data::MultiValued::TagContainer'), + init_arg => undef, + lazy_build => 1, +); + +sub _build__storage { + Data::MultiValued::TagContainer->new(); +} + +sub set { + my ($self,%args) = validated_hash( + \@_, + tag => { isa => Str, optional => 1, }, + value => { isa => Any, }, + ); + + $self->_storage->get_or_create(\%args) + ->{value} = $args{value}; +} + +sub get { + my ($self,%args) = validated_hash( + \@_, + tag => { isa => Str, optional => 1, }, + ); + + $self->_storage->get(\%args) + ->{value}; +} + +sub clear { + my ($self) = @_; + + $self->_clear_storage; +} + +1; diff --git a/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm new file mode 100644 index 0000000..e940449 --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm @@ -0,0 +1,54 @@ +package Data::MultiValued::TagsAndRanges; +use Moose; +use MooseX::Params::Validate; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(Num Str Undef Any); +use Data::MultiValued::Exceptions; +use Data::MultiValued::TagContainerForRanges; + +# ABSTRACT: Handle values with tags and validity ranges + +has _storage => ( + is => 'rw', + isa => class_type('Data::MultiValued::TagContainerForRanges'), + init_arg => undef, + lazy_build => 1, +); + +sub _build__storage { + Data::MultiValued::TagContainerForRanges->new(); +} + +sub set { + my ($self,%args) = validated_hash( + \@_, + from => { isa => Num|Undef, optional => 1, }, + to => { isa => Num|Undef, optional => 1, }, + tag => { isa => Str, optional => 1, }, + value => { isa => Any, }, + ); + + $self->_storage->get_or_create(\%args) + ->set_or_create(\%args) + ->{value} = $args{value}; +} + +sub get { + my ($self,%args) = validated_hash( + \@_, + at => { isa => Num|Undef, optional => 1, }, + tag => { isa => Str, optional => 1, }, + ); + + $self->_storage->get(\%args) + ->get(\%args) + ->{value}; +} + +sub clear { + my ($self) = @_; + + $self->_clear_storage; +} + +1; diff --git a/Data-MultiValued/t/more-overlapping-ranges.t b/Data-MultiValued/t/more-overlapping-ranges.t index 9ff1dc2..19e2fe5 100644 --- a/Data-MultiValued/t/more-overlapping-ranges.t +++ b/Data-MultiValued/t/more-overlapping-ranges.t @@ -3,61 +3,77 @@ use strict; use warnings; use Test::Most 'die'; use Data::Printer; -use Data::MultiValued; - -my $obj = Data::MultiValued->new(); -ok($obj,'constructor works'); - -$obj->set({ - from=>10, - to=>20, - value=>1, -}); -$obj->set({ - from=>30, - to => 50, - value => 2, -}); -$obj->set({ - from=>15, - to => 35, - value => 3, -}); -$obj->set({ - from => undef, - to => 12, - value => 4, -}); -$obj->set({ - from => 40, - to => undef, - value => 5, -}); - -my %points = ( - 1,4, - 9,4, - 10,4, - 11,4, - 12,1, - 13,1, - 14,1, - 15,3, - 19,3, - 20,3, - 30,3, - 34,3, - 35,2, - 39,2, - 40,5, - 50,5, - 200,5, -); -while (my ($at,$v) = each %points) { - cmp_ok($obj->get({at=>$at}), - '==', - $v, - "value at $at"); +use Data::MultiValued::Ranges; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + + $obj->set({ + from=>10, + to=>20, + value=>1, + }); + $obj->set({ + from=>30, + to => 50, + value => 2, + }); + $obj->set({ + from=>15, + to => 35, + value => 3, + }); + $obj->set({ + from => undef, + to => 12, + value => 4, + }); + $obj->set({ + from => 40, + to => undef, + value => 5, + }); + + my %points = ( + 1,4, + 9,4, + 10,4, + 11,4, + 12,1, + 13,1, + 14,1, + 15,3, + 19,3, + 20,3, + 30,3, + 34,3, + 35,2, + 39,2, + 40,5, + 50,5, + 200,5, + ); + while (my ($at,$v) = each %points) { + cmp_ok($obj->get({at=>$at}), + '==', + $v, + "value at $at"); + } } +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + done_testing(); diff --git a/Data-MultiValued/t/overlapping-ranges.t b/Data-MultiValued/t/overlapping-ranges.t index e359894..01bb98d 100644 --- a/Data-MultiValued/t/overlapping-ranges.t +++ b/Data-MultiValued/t/overlapping-ranges.t @@ -3,46 +3,62 @@ use strict; use warnings; use Test::Most 'die'; use Data::Printer; -use Data::MultiValued; - -my $obj = Data::MultiValued->new(); -ok($obj,'constructor works'); - -$obj->set({ - from=>10, - to=>20, - value=>1, -}); -$obj->set({ - from=>15, - to => 30, - value => 2, -}); - -my %points = ( - 10,1, - 12,1, - 13,1, - 14,1, - 15,2, - 17,2, - 19,2, - 20,2, - 25,2, - 29,2, -); -while (my ($at,$v) = each %points) { - cmp_ok($obj->get({at=>$at}), - '==', - $v, - "value at $at"); +use Data::MultiValued::Ranges; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + $obj->set({ + from=>10, + to=>20, + value=>1, + }); + $obj->set({ + from=>15, + to => 30, + value => 2, + }); + + my %points = ( + 10,1, + 12,1, + 13,1, + 14,1, + 15,2, + 17,2, + 19,2, + 20,2, + 25,2, + 29,2, + ); + while (my ($at,$v) = each %points) { + cmp_ok($obj->get({at=>$at}), + '==', + $v, + "value at $at"); + } + + dies_ok { + $obj->get({at=>30}) + } 'far end'; + dies_ok { + $obj->get({at=>9}) + } 'far end'; } -dies_ok { - $obj->get({at=>30}) -} 'far end'; -dies_ok { - $obj->get({at=>9}) -} 'far end'; + +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; done_testing(); diff --git a/Data-MultiValued/t/ranges-setting.t b/Data-MultiValued/t/ranges-setting.t index 148a4c6..ff6a6b3 100644 --- a/Data-MultiValued/t/ranges-setting.t +++ b/Data-MultiValued/t/ranges-setting.t @@ -3,58 +3,74 @@ use strict; use warnings; use Test::Most 'die'; use Data::Printer; -use Data::MultiValued; - -my $obj = Data::MultiValued->new(); -ok($obj,'constructor works'); - -lives_ok { - $obj->set({ - from => 10, - to => 20, - value => [1,2,3], - }); -} 'setting 10-20'; -lives_ok { - $obj->set({ - from => 30, - to => 50, - value => [4,5,6], - }); -} 'setting 30-50'; - -cmp_deeply($obj->get({at => 15}), - [1,2,3], - 'getting 15'); -cmp_deeply($obj->get({at => 10}), - [1,2,3], - 'getting 10'); -cmp_deeply($obj->get({at => 19.999}), - [1,2,3], - 'getting 19.999'); -dies_ok { - $obj->get({at => 20}) -} 'getting 20 dies'; - -cmp_deeply($obj->get({at => 40}), - [4,5,6], - 'getting 40'); -cmp_deeply($obj->get({at => 30}), - [4,5,6], - 'getting 30'); -cmp_deeply($obj->get({at => 49.999}), - [4,5,6], - 'getting 49.999'); -dies_ok { - $obj->get({at => 50}) -} 'getting 50 dies'; - -dies_ok { - $obj->get({at => 0}) -} 'getting 0 dies'; - -dies_ok { - $obj->get({}); -} 'default get dies'; +use Data::MultiValued::Ranges; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + + lives_ok { + $obj->set({ + from => 10, + to => 20, + value => [1,2,3], + }); + } 'setting 10-20'; + lives_ok { + $obj->set({ + from => 30, + to => 50, + value => [4,5,6], + }); + } 'setting 30-50'; + + cmp_deeply($obj->get({at => 15}), + [1,2,3], + 'getting 15'); + cmp_deeply($obj->get({at => 10}), + [1,2,3], + 'getting 10'); + cmp_deeply($obj->get({at => 19.999}), + [1,2,3], + 'getting 19.999'); + dies_ok { + $obj->get({at => 20}) + } 'getting 20 dies'; + + cmp_deeply($obj->get({at => 40}), + [4,5,6], + 'getting 40'); + cmp_deeply($obj->get({at => 30}), + [4,5,6], + 'getting 30'); + cmp_deeply($obj->get({at => 49.999}), + [4,5,6], + 'getting 49.999'); + dies_ok { + $obj->get({at => 50}) + } 'getting 50 dies'; + + dies_ok { + $obj->get({at => 0}) + } 'getting 0 dies'; + + dies_ok { + $obj->get({}); + } 'default get dies'; +} + +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; done_testing(); diff --git a/Data-MultiValued/t/simple-setting.t b/Data-MultiValued/t/simple-setting.t index b478e7a..9d9a9e2 100644 --- a/Data-MultiValued/t/simple-setting.t +++ b/Data-MultiValued/t/simple-setting.t @@ -3,20 +3,44 @@ use strict; use warnings; use Test::Most 'die'; use Data::Printer; -use Data::MultiValued; +use Data::MultiValued::Ranges; +use Data::MultiValued::Tags; +use Data::MultiValued::TagsAndRanges; -my $obj = Data::MultiValued->new(); -ok($obj,'constructor works'); +sub test_it { + my ($obj) = @_; -lives_ok { - $obj->set({ - value => 1234, - }); -} 'setting'; + lives_ok { + $obj->set({ + value => 1234, + }); + } 'setting'; -cmp_ok($obj->get({}),'==',1234, - 'getting'); + cmp_ok($obj->get({}),'==',1234, + 'getting'); -lives_ok { $obj->clear } 'clearing the object'; + lives_ok { $obj->clear } 'clearing the object'; +} + +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags' => sub { + my $obj = Data::MultiValued::Tags->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; done_testing(); diff --git a/Data-MultiValued/t/tags-ranges-setting.t b/Data-MultiValued/t/tags-ranges-setting.t index 7214ebe..5f82a4e 100644 --- a/Data-MultiValued/t/tags-ranges-setting.t +++ b/Data-MultiValued/t/tags-ranges-setting.t @@ -3,9 +3,9 @@ use strict; use warnings; use Test::Most 'die'; use Data::Printer; -use Data::MultiValued; +use Data::MultiValued::TagsAndRanges; -my $obj = Data::MultiValued->new(); +my $obj = Data::MultiValued::TagsAndRanges->new(); ok($obj,'constructor works'); my @tags = (undef,'tag1','tag2'); diff --git a/Data-MultiValued/t/tags-setting.t b/Data-MultiValued/t/tags-setting.t index d9f6fd8..5029d2d 100644 --- a/Data-MultiValued/t/tags-setting.t +++ b/Data-MultiValued/t/tags-setting.t @@ -3,40 +3,56 @@ use strict; use warnings; use Test::Most 'die'; use Data::Printer; -use Data::MultiValued; - -my $obj = Data::MultiValued->new(); -ok($obj,'constructor works'); - -lives_ok { - $obj->set({ - tag => 'tag1', - value => 'a string', - }); -} 'setting tag1'; -lives_ok { - $obj->set({ - tag => 'tag2', - value => 'another string', - }); -} 'setting tag2'; - -cmp_ok($obj->get({tag => 'tag1'}), - 'eq', - 'a string', - 'getting tag1'); - -cmp_ok($obj->get({tag => 'tag2'}), - 'eq', - 'another string', - 'getting tag2'); - -dies_ok { - $obj->get({tag=>'no such tag'}); -} 'getting non-existent tag'; - -dies_ok { - $obj->get({}); -} 'default get dies'; +use Data::MultiValued::Tags; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + + lives_ok { + $obj->set({ + tag => 'tag1', + value => 'a string', + }); + } 'setting tag1'; + lives_ok { + $obj->set({ + tag => 'tag2', + value => 'another string', + }); + } 'setting tag2'; + + cmp_ok($obj->get({tag => 'tag1'}), + 'eq', + 'a string', + 'getting tag1'); + + cmp_ok($obj->get({tag => 'tag2'}), + 'eq', + 'another string', + 'getting tag2'); + + dies_ok { + $obj->get({tag=>'no such tag'}); + } 'getting non-existent tag'; + + dies_ok { + $obj->get({}); + } 'default get dies'; +} + +subtest 'tags' => sub { + my $obj = Data::MultiValued::Tags->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; done_testing(); -- cgit v1.2.3