From 89205936dac4ae34332cc7c04b49467808f7014e Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Wed, 9 Nov 2011 12:50:03 +0000 Subject: storage class for tags/ranges --- .gitignore | 3 + Data-TagsAndRanges/.gitignore | 13 +++ Data-TagsAndRanges/dist.ini | 69 ++++++++++++ Data-TagsAndRanges/lib/Data/TagsAndRanges.pm | 54 ++++++++++ .../lib/Data/TagsAndRanges/Exceptions.pm | 38 +++++++ .../lib/Data/TagsAndRanges/RangeContainer.pm | 91 ++++++++++++++++ .../lib/Data/TagsAndRanges/TagContainer.pm | 73 +++++++++++++ Data-TagsAndRanges/t/setting.t | 118 +++++++++++++++++++++ 8 files changed, 459 insertions(+) create mode 100644 .gitignore create mode 100644 Data-TagsAndRanges/.gitignore create mode 100644 Data-TagsAndRanges/dist.ini create mode 100644 Data-TagsAndRanges/lib/Data/TagsAndRanges.pm create mode 100644 Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm create mode 100644 Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm create mode 100644 Data-TagsAndRanges/lib/Data/TagsAndRanges/TagContainer.pm create mode 100644 Data-TagsAndRanges/t/setting.t diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..68f70d8 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.sw? +*.tar.gz +*~ diff --git a/Data-TagsAndRanges/.gitignore b/Data-TagsAndRanges/.gitignore new file mode 100644 index 0000000..a916a46 --- /dev/null +++ b/Data-TagsAndRanges/.gitignore @@ -0,0 +1,13 @@ +blib +pm_to_blib +*.sw? +Makefile +Makefile.old +MANIFEST.bak +*.tar.gz +/inc/ +META.yml +.prove +*~ +/.build/ +/Data-/ diff --git a/Data-TagsAndRanges/dist.ini b/Data-TagsAndRanges/dist.ini new file mode 100644 index 0000000..b69e340 --- /dev/null +++ b/Data-TagsAndRanges/dist.ini @@ -0,0 +1,69 @@ +name = Data-TagsAndRanges +author = Gianni Ceccarelli +license = Perl_5 +copyright_holder = Net-a-porter.com +copyright_year = 2011 + +abstract = Handle values with tags and validity ranges + +[GatherDir] + +[PodWeaver] + +[PruneCruft] + +[PruneFiles] +match = ~$ + +[Git::Check] +allow_dirty = dist.ini + +[Git::NextVersion] +first_version = 0.0.1 + +[Git::Commit] + +[Git::CommitBuild] + +[Git::Tag] + +[CheckChangeLog] + +[NextRelease] + +[AutoPrereqs] + +[PkgDist] + +[PkgVersion] + +[ManifestSkip] + +[NoTabsTests] + +[PodCoverageTests] + +[PodSyntaxTests] + +[ExtraTests] + +[MetaNoIndex] + +directory = t/lib + +[MetaYAML] + +[MetaJSON] + +[ExecDir] + +[ShareDir] + +[MakeMaker] + +[Manifest] + +[TestRelease] + +;[ConfirmRelease] +;[UploadToCPAN] \ No newline at end of file diff --git a/Data-TagsAndRanges/lib/Data/TagsAndRanges.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges.pm new file mode 100644 index 0000000..7c8ed7b --- /dev/null +++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges.pm @@ -0,0 +1,54 @@ +package Data::TagsAndRanges; +use Moose; +use MooseX::Params::Validate; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(Num Str Undef Any); +use Data::TagsAndRanges::Exceptions; +use Data::TagsAndRanges::TagContainer; + +# ABSTRACT: Handle values with tags and validity ranges + +has _storage => ( + is => 'rw', + isa => class_type('Data::TagsAndRanges::TagContainer'), + init_arg => undef, + lazy_build => 1, +); + +sub _build__storage { + Data::TagsAndRanges::TagContainer->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-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm new file mode 100644 index 0000000..c28824b --- /dev/null +++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm @@ -0,0 +1,38 @@ +package Data::TagsAndRanges::Exceptions; +package Data::TagsAndRanges::Exceptions::NotFound;{ +use Moose; +extends 'Throwable::Error'; + +has value => ( + is => 'ro', + required => 1, +); + +sub as_string { + my ($self) = @_; + + my $str = $self->message . $self->value; + $str .= "\n\n" . $self->stack_trace->as_string; + + return $str; +} + +} +package Data::TagsAndRanges::Exceptions::TagNotFound;{ +use Moose; +extends 'Data::TagsAndRanges::Exceptions::NotFound'; + +has '+message' => ( + default => 'tag not found: ', +); +} +package Data::TagsAndRanges::Exceptions::RangeNotFound;{ +use Moose; +extends 'Data::TagsAndRanges::Exceptions::NotFound'; + +has '+message' => ( + default => 'no range found for value ', +); +} + +1; diff --git a/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm new file mode 100644 index 0000000..5f3653a --- /dev/null +++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm @@ -0,0 +1,91 @@ +package Data::TagsAndRanges::RangeContainer; +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(Num Str Any Undef ArrayRef); +use MooseX::Types::Structured qw(Dict); +use Data::TagsAndRanges::Exceptions; + +has _storage => ( + is => 'rw', + isa => ArrayRef[ + Dict[ + from => Num|Undef, + to => Num|Undef, + value => Any, + ], + ], + init_arg => undef, + default => sub { [ ] }, +); + +sub get { + my ($self,$args) = @_; + + my $at = $args->{at}; + + my ($range) = $self->_get_slot_at($at); + + if (!$range) { + Data::TagsAndRanges::Exceptions::RangeNotFound->throw({ + value => $at, + }); + } + + return $range; +} + +sub _cmp_less { + return if !defined $_[0]; + return 1 if !defined $_[1]; + return $_[0] <= $_[1]; +} +sub _cmp_more { + return if !defined $_[0]; + return 1 if !defined $_[1]; + return $_[0] > $_[1]; +} +sub _cmp_eq { + return 1 if !defined($_[0]) && !defined($_[1]); + return if defined($_[0]) xor defined($_[1]); + return $_[0] == $_[1]; +} + +sub _get_slot_at { + my ($self,$at) = @_; + + for my $slot (@{$self->_storage}) { + next if _cmp_less($slot->{to},$at); + last if _cmp_more($slot->{from},$at); + return $slot; + } + return; +} + +sub set_or_create { + my ($self,$args) = @_; + + my $from = $args->{from}; + my $to = $args->{to}; + + my ($range) = $self->_get_slot_at($from); + + if ($range && _cmp_eq($range->{from},$from) && _cmp_eq($range->{to},$to)) { + return $range; + } + + $range = $self->_create_slot($from,$to); + return $range; +} + +sub _create_slot { + my ($self,$from,$to) = @_; + + push @{$self->_storage},{ + from => $from, + to => $to, + value => undef, + }; + return $self->_storage->[-1]; +} + +1; diff --git a/Data-TagsAndRanges/lib/Data/TagsAndRanges/TagContainer.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges/TagContainer.pm new file mode 100644 index 0000000..c820f9a --- /dev/null +++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges/TagContainer.pm @@ -0,0 +1,73 @@ +package Data::TagsAndRanges::TagContainer; +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(HashRef); +use Data::TagsAndRanges::Exceptions; +use Data::TagsAndRanges::RangeContainer; + +has _storage => ( + is => 'rw', + isa => HashRef[class_type('Data::TagsAndRanges::RangeContainer')], + init_arg => undef, + default => sub { { } }, + traits => ['Hash'], + handles => { + _has_tag => 'exists', + _get_tag => 'get', + _create_tag => 'set', + }, +); + +has _default_range => ( + is => 'rw', + isa => class_type('Data::TagsAndRanges::RangeContainer'), + init_arg => undef, + predicate => '_has_default_range', +); + +sub get { + my ($self,$args) = @_; + + my $tag = $args->{tag}; + + if (!defined($tag)) { + if ($self->_has_default_range) { + return $self->_default_range; + } + + Data::TagsAndRanges::Exceptions::TagNotFound->throw({ + value => $tag, + }); + } + + if (!$self->_has_tag($tag)) { + Data::TagsAndRanges::Exceptions::TagNotFound->throw({ + value => $tag, + }); + } + return $self->_get_tag($tag); +} + +sub get_or_create { + my ($self,$args) = @_; + + my $tag = $args->{tag}; + + if (!defined($tag)) { + if ($self->_has_default_range) { + return $self->_default_range; + } + else { + return $self->_default_range( + Data::TagsAndRanges::RangeContainer->new() + ); + } + } + + if (!$self->_has_tag($tag)) { + $self->_create_tag($tag,Data::TagsAndRanges::RangeContainer->new()); + } + return $self->_get_tag($tag); +} + +1; diff --git a/Data-TagsAndRanges/t/setting.t b/Data-TagsAndRanges/t/setting.t new file mode 100644 index 0000000..0eba1ef --- /dev/null +++ b/Data-TagsAndRanges/t/setting.t @@ -0,0 +1,118 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::TagsAndRanges; + +my $obj = Data::TagsAndRanges->new(); +ok($obj,'constructor works'); + +sub clear_it { + lives_ok { $obj->clear } 'clearing the object'; +} + +subtest 'no ranges or tags' => sub { + clear_it; + + lives_ok { + $obj->set({ + value => 1234, + }); + } 'setting'; + + cmp_ok($obj->get({}),'==',1234, + 'getting'); +}; + +subtest 'tags' => sub { + clear_it; + + 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 'ranges' => sub { + clear_it; + + 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'; + + note p $obj; + + dies_ok { + $obj->get({}); + } 'default get dies'; +}; + +done_testing(); -- cgit v1.2.3