summaryrefslogtreecommitdiff
path: root/Data-MultiValued
diff options
context:
space:
mode:
Diffstat (limited to 'Data-MultiValued')
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/Ranges.pm50
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/Tags.pm49
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm (renamed from Data-MultiValued/lib/Data/MultiValued.pm)2
-rw-r--r--Data-MultiValued/t/more-overlapping-ranges.t126
-rw-r--r--Data-MultiValued/t/overlapping-ranges.t94
-rw-r--r--Data-MultiValued/t/ranges-setting.t122
-rw-r--r--Data-MultiValued/t/simple-setting.t46
-rw-r--r--Data-MultiValued/t/tags-ranges-setting.t4
-rw-r--r--Data-MultiValued/t/tags-setting.t86
9 files changed, 383 insertions, 196 deletions
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.pm b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
index 65b041d..e940449 100644
--- a/Data-MultiValued/lib/Data/MultiValued.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
@@ -1,4 +1,4 @@
-package Data::MultiValued;
+package Data::MultiValued::TagsAndRanges;
use Moose;
use MooseX::Params::Validate;
use Moose::Util::TypeConstraints;
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();
generated by cgit v1.2.3 (git 2.46.0) at 2025-05-01 16:47:00 +0000