diff options
| -rw-r--r-- | .gitignore | 13 | ||||
| -rw-r--r-- | Changes | 2 | ||||
| -rw-r--r-- | MANIFEST | 33 | ||||
| -rw-r--r-- | META.json | 57 | ||||
| -rw-r--r-- | META.yml | 37 | ||||
| -rw-r--r-- | Makefile.PL | 69 | ||||
| -rw-r--r-- | lib/Data/MultiValued.pm | 33 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeAccessors.pm | 112 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait.pm | 456 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait/Ranges.pm | 54 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait/Tags.pm | 54 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm | 54 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Exceptions.pm | 151 | ||||
| -rw-r--r-- | lib/Data/MultiValued/RangeContainer.pm | 144 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Ranges.pm | 164 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagContainer.pm | 146 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagContainerForRanges.pm | 95 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Tags.pm | 158 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagsAndRanges.pm | 173 | ||||
| -rw-r--r-- | lib/Data/MultiValued/UglySerializationHelperRole.pm | 102 | ||||
| -rw-r--r-- | t/release-no-tabs.t | 16 | ||||
| -rw-r--r-- | t/release-pod-coverage.t | 21 | ||||
| -rw-r--r-- | t/release-pod-syntax.t | 15 |
23 files changed, 1417 insertions, 742 deletions
diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 3baba5b..0000000 --- a/.gitignore +++ /dev/null @@ -1,13 +0,0 @@ -blib -pm_to_blib -*.sw? -Makefile -Makefile.old -MANIFEST.bak -*.tar.gz -/inc/ -META.yml -.prove -*~ -/.build/ -/Data-*/ @@ -1,6 +1,6 @@ Revision history for Data::MultiValued -{{$NEXT}} +0.0.1_3 2011-12-05 13:54:07 Europe/London 0.0.1_2 2011-11-30 11:01:47 Europe/London - remove the need for perl 5.12 diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..36cc917 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,33 @@ +Changes +MANIFEST +META.json +META.yml +Makefile.PL +dist.ini +lib/Data/MultiValued.pm +lib/Data/MultiValued/AttributeAccessors.pm +lib/Data/MultiValued/AttributeTrait.pm +lib/Data/MultiValued/AttributeTrait/Ranges.pm +lib/Data/MultiValued/AttributeTrait/Tags.pm +lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm +lib/Data/MultiValued/Exceptions.pm +lib/Data/MultiValued/RangeContainer.pm +lib/Data/MultiValued/Ranges.pm +lib/Data/MultiValued/TagContainer.pm +lib/Data/MultiValued/TagContainerForRanges.pm +lib/Data/MultiValued/Tags.pm +lib/Data/MultiValued/TagsAndRanges.pm +lib/Data/MultiValued/UglySerializationHelperRole.pm +t/json.t +t/moose-ranges.t +t/moose-tagged.t +t/more-overlapping-ranges.t +t/overlapping-ranges.t +t/ranges-setting.t +t/release-no-tabs.t +t/release-pod-coverage.t +t/release-pod-syntax.t +t/simple-setting.t +t/tags-ranges-setting.t +t/tags-setting.t +weaver.ini diff --git a/META.json b/META.json new file mode 100644 index 0000000..2fbcc60 --- /dev/null +++ b/META.json @@ -0,0 +1,57 @@ +{ + "abstract" : "Handle values with tags and validity ranges", + "author" : [ + "Gianni Ceccarelli <dakkar@thenautilus.net>" + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 4.300003, CPAN::Meta::Converter version 2.112621", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Data-MultiValued", + "no_index" : { + "directory" : [ + "t/lib" + ] + }, + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "6.30" + } + }, + "runtime" : { + "requires" : { + "Carp" : 0, + "Moose" : 0, + "Moose::Meta::Method::Accessor" : 0, + "Moose::Role" : 0, + "Moose::Util::TypeConstraints" : 0, + "MooseX::Params::Validate" : 0, + "MooseX::Types::Moose" : 0, + "MooseX::Types::Structured" : 0, + "Throwable::Error" : 0, + "Try::Tiny" : 0, + "base" : 0, + "namespace::autoclean" : 0, + "strict" : 0, + "warnings" : 0 + } + }, + "test" : { + "requires" : { + "Data::Printer" : 0, + "JSON::XS" : 0, + "Test::More" : 0, + "Test::Most" : 0 + } + } + }, + "release_status" : "testing", + "version" : "0.0.1_3" +} + diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..d86ea31 --- /dev/null +++ b/META.yml @@ -0,0 +1,37 @@ +--- +abstract: 'Handle values with tags and validity ranges' +author: + - 'Gianni Ceccarelli <dakkar@thenautilus.net>' +build_requires: + Data::Printer: 0 + JSON::XS: 0 + Test::More: 0 + Test::Most: 0 +configure_requires: + ExtUtils::MakeMaker: 6.30 +dynamic_config: 0 +generated_by: 'Dist::Zilla version 4.300003, CPAN::Meta::Converter version 2.112621' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Data-MultiValued +no_index: + directory: + - t/lib +requires: + Carp: 0 + Moose: 0 + Moose::Meta::Method::Accessor: 0 + Moose::Role: 0 + Moose::Util::TypeConstraints: 0 + MooseX::Params::Validate: 0 + MooseX::Types::Moose: 0 + MooseX::Types::Structured: 0 + Throwable::Error: 0 + Try::Tiny: 0 + base: 0 + namespace::autoclean: 0 + strict: 0 + warnings: 0 +version: 0.0.1_3 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..aa5daea --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,69 @@ + +use strict; +use warnings; + + + +use ExtUtils::MakeMaker 6.30; + + + +my %WriteMakefileArgs = ( + "ABSTRACT" => "Handle values with tags and validity ranges", + "AUTHOR" => "Gianni Ceccarelli <dakkar\@thenautilus.net>", + "BUILD_REQUIRES" => { + "Data::Printer" => 0, + "JSON::XS" => 0, + "Test::More" => 0, + "Test::Most" => 0 + }, + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => "6.30" + }, + "DISTNAME" => "Data-MultiValued", + "EXE_FILES" => [], + "LICENSE" => "perl", + "NAME" => "Data::MultiValued", + "PREREQ_PM" => { + "Carp" => 0, + "Moose" => 0, + "Moose::Meta::Method::Accessor" => 0, + "Moose::Role" => 0, + "Moose::Util::TypeConstraints" => 0, + "MooseX::Params::Validate" => 0, + "MooseX::Types::Moose" => 0, + "MooseX::Types::Structured" => 0, + "Throwable::Error" => 0, + "Try::Tiny" => 0, + "base" => 0, + "namespace::autoclean" => 0, + "strict" => 0, + "warnings" => 0 + }, + "VERSION" => "0.0.1_3", + "test" => { + "TESTS" => "t/*.t" + } +); + + +unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { + my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; + my $pp = $WriteMakefileArgs{PREREQ_PM}; + for my $mod ( keys %$br ) { + if ( exists $pp->{$mod} ) { + $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; + } + else { + $pp->{$mod} = $br->{$mod}; + } + } +} + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +WriteMakefile(%WriteMakefileArgs); + + + diff --git a/lib/Data/MultiValued.pm b/lib/Data/MultiValued.pm index aff7a17..c1f1681 100644 --- a/lib/Data/MultiValued.pm +++ b/lib/Data/MultiValued.pm @@ -1,4 +1,10 @@ package Data::MultiValued; +{ + $Data::MultiValued::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::DIST = 'Data-MultiValued'; +} use strict; use warnings; # ABSTRACT: store tag- and range-dependant data in a scalar or Moose attribute @@ -7,6 +13,20 @@ warn "Don't use this module directly, use Data::MultiValued::Tags or Data::Multi 1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued - store tag- and range-dependant data in a scalar or Moose attribute + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS use Data::MultiValued::Tags; @@ -74,3 +94,16 @@ L<Data::MultiValued::AttributeTrait::Ranges> and L<Data::MultiValued::AttributeTrait::TagsAndRanges> for the Moose attribute traits. +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Data/MultiValued/AttributeAccessors.pm b/lib/Data/MultiValued/AttributeAccessors.pm index 8480f98..63e9281 100644 --- a/lib/Data/MultiValued/AttributeAccessors.pm +++ b/lib/Data/MultiValued/AttributeAccessors.pm @@ -1,4 +1,10 @@ package Data::MultiValued::AttributeAccessors; +{ + $Data::MultiValued::AttributeAccessors::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::AttributeAccessors::DIST = 'Data-MultiValued'; +} use strict; use warnings; use base 'Moose::Meta::Method::Accessor'; @@ -6,34 +12,9 @@ use Carp 'confess'; # ABSTRACT: method meta-class for multi-valued attribute accessors -=head1 DESCRIPTION - -Subclass of L<Moose::Meta::Method::Accessor>, generates non-inlined -(patches welcome) accessors for multi-valued attributes. - -=method C<_instance_is_inlinable> - -Returns C<0> to prevent attempts to inline the accessor methods. - -=cut sub _instance_is_inlinable { 0 } -=method C<_generate_accessor_method> - -=method C<_generate_reader_method> - -=method C<_generate_writer_method> - -=method C<_generate_predicate_method> - -=method C<_generate_clearer_method> - -Delegate to C<set_multi_value>, C<get_multi_value>, -C<has_multi_value>, C<clear_multi_value>, passing empty options -(i.e. no tags, no ranges). - -=cut sub _generate_accessor_method { my $self = shift; @@ -85,21 +66,6 @@ sub _generate_clearer_method { }; } -=method C<_generate_multi_accessor_method> - -=method C<_generate_multi_reader_method> - -=method C<_generate_multi_writer_method> - -=method C<_generate_multi_predicate_method> - -=method C<_generate_multi_clearer_method> - -Delegate to C<set_multi_value>, C<get_multi_value>, -C<has_multi_value>, C<clear_multi_value>, passing C<$_[1]> as options -and C<$_[2]> as values. - -=cut sub _generate_multi_accessor_method { my $self = shift; @@ -152,3 +118,69 @@ sub _generate_multi_clearer_method { } 1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::AttributeAccessors - method meta-class for multi-valued attribute accessors + +=head1 VERSION + +version 0.0.1_3 + +=head1 DESCRIPTION + +Subclass of L<Moose::Meta::Method::Accessor>, generates non-inlined +(patches welcome) accessors for multi-valued attributes. + +=head1 METHODS + +=head2 C<_instance_is_inlinable> + +Returns C<0> to prevent attempts to inline the accessor methods. + +=head2 C<_generate_accessor_method> + +=head2 C<_generate_reader_method> + +=head2 C<_generate_writer_method> + +=head2 C<_generate_predicate_method> + +=head2 C<_generate_clearer_method> + +Delegate to C<set_multi_value>, C<get_multi_value>, +C<has_multi_value>, C<clear_multi_value>, passing empty options +(i.e. no tags, no ranges). + +=head2 C<_generate_multi_accessor_method> + +=head2 C<_generate_multi_reader_method> + +=head2 C<_generate_multi_writer_method> + +=head2 C<_generate_multi_predicate_method> + +=head2 C<_generate_multi_clearer_method> + +Delegate to C<set_multi_value>, C<get_multi_value>, +C<has_multi_value>, C<clear_multi_value>, passing C<$_[1]> as options +and C<$_[2]> as values. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Data/MultiValued/AttributeTrait.pm b/lib/Data/MultiValued/AttributeTrait.pm index b514a59..322feb2 100644 --- a/lib/Data/MultiValued/AttributeTrait.pm +++ b/lib/Data/MultiValued/AttributeTrait.pm @@ -1,4 +1,10 @@ package Data::MultiValued::AttributeTrait; +{ + $Data::MultiValued::AttributeTrait::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::AttributeTrait::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::AttributeAccessors; use MooseX::Types::Moose qw(Str); @@ -7,46 +13,6 @@ use namespace::autoclean; # ABSTRACT: "base role" for traits of multi-valued Moose attributes -=head1 DESCRIPTION - -Don't use this role directly, use -L<Data::MultiValued::AttributeTrait::Tags>, -L<Data::MultiValued::AttributeTrait::Ranges> or -L<Data::MultiValued::AttributeTrait::TagsAndRanges>. - -This role (together with L<Data::MultiValued::AttributeAccessors>) -defines all the basic plumbing to glue C<Data::MultiValued::Tags> etc -into Moose attributes. - -=head1 Implementation details - -The multi-value object is stored in the instance slot named by the -L</full_storage_slot> attribute attribute. C<before> modifiers on -getters load the appropriate value from the multi-value object into -the regular instance slot, C<after> modifiers on setters store the -value from the regular instance slot into the multi-value object. - -=head1 ATTRIBUTES - -These are the attributes that this trait adds to the attribute in -your class. Example: - - has stuff => ( - is => 'rw', - isa => 'Int', - traits => ['MultiValued::Tags'], - predicate => 'has_stuff', - multi_accessor => 'stuff_tagged', - multi_predicate => 'has_stuff_tagged', - ); - -=attr C<full_storage_slot> - -The instance slot to use to store the C<Data::MultiValued::Tags> or -similar object. Defaults to C<"${name}__MULTIVALUED_STORAGE__">, where -C<$name> is the attribute name. - -=cut has 'full_storage_slot' => ( is => 'ro', @@ -55,30 +21,6 @@ has 'full_storage_slot' => ( ); sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' } -=attr C<multi_accessor> - -=attr C<multi_reader> - -=attr C<multi_writer> - -=attr C<multi_predicate> - -=attr C<multi_clearer> - -The names to use for the various additional accessors. See -L<Class::MOP::Attribute> for details. These default to -C<"${name}_multi"> where C<$name> is the name of the corresponding -non-multi accessor. So, for example, - - has stuff => ( - is => 'rw', - traits => ['MultiValued::Tags'], - ); - -will create a C<stuff> read / write accessor and a C<stuff_multi> read -/ write tagged accessor. - -=cut my @accs_to_multiply=qw(accessor reader writer predicate clearer); @@ -90,54 +32,21 @@ for my $acc (@accs_to_multiply) { ); } -=head1 REQUIREMENTS - -These methods must be provided by any class consuming this role. See -L<Data::MultiValued::AttributeTrait::Tags> etc. for examples. - -=head2 C<multivalue_storage_class> - -The class to use to create the multi-value objects. - -=cut requires 'multivalue_storage_class'; -=head2 C<opts_to_pass_set> - -Which options to pass from the multi-value accessors to the C<set> -method of the multi-value object. - -=cut requires 'opts_to_pass_set'; -=head2 C<opts_to_pass_get> - -Which options to pass from the multi-value accessors to the C<get> -method of the multi-value object. - -=cut requires 'opts_to_pass_get'; -=method C<slots> - -Adds the L</full_storage_slot> to the list of used slots. - -=cut around slots => sub { my ($orig, $self) = @_; return ($self->$orig(), $self->full_storage_slot); }; -=method C<set_full_storage> - -Stores a new instance of L</multivalue_storage_class> into the -L</full_storage_slot> of the instance. - -=cut sub set_full_storage { my ($self,$instance) = @_; @@ -151,11 +60,6 @@ sub set_full_storage { return $ret; } -=method C<get_full_storage> - -Retrieves the value of the L</full_storage_slot> of the instance. - -=cut sub get_full_storage { my ($self,$instance) = @_; @@ -167,13 +71,6 @@ sub get_full_storage { ); } -=method C<full_storage> - -Returns an instance of L</multivalue_storage_class>, either by -retrieving it from the instance, or by creating one (and setting it in -the instance). Calls L</get_full_storage> and L</set_full_storage>. - -=cut sub full_storage { my ($self,$instance) = @_; @@ -182,28 +79,9 @@ sub full_storage { || $self->set_full_storage($instance); } -=method C<accessor_metaclass> - -Makes sure that all accessors for this attribute are created via the -L<Data::MultiValued::AttributeAccessors> method meta class. - -=cut sub accessor_metaclass { 'Data::MultiValued::AttributeAccessors' } -=method C<install_accessors> - -After the regular L<Moose::Meta::Attribute> method, installs the -multi-value accessors. - -Each installed normal accessor gets a multi-value version - -You can add or rename the multi-value version by using the attributes -described above - -If you are passing explicit subrefs for your accessors, things won't work. - -=cut after install_accessors => sub { my ($self) = @_; @@ -244,18 +122,6 @@ sub _filter_opts { return \%ret; } -=method C<load_multi_value> - -Retrieves a value from the multi-value object, and stores it in the -regular slot in the instance. If the value is not found, clears the -slot. - -This traps the -L<Data::MultiValued::Exceptions::NotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::NotFound> -exception that may be thrown by the multi-value object, but re-throws -any other exception. - -=cut sub load_multi_value { my ($self,$instance,$opts) = @_; @@ -281,13 +147,6 @@ sub load_multi_value { } } -=method C<raw_clear_value> - -Clears the instance slot. Does the same as -L<Moose::Meta::Attribute/clear_value>, but we need this method because -the other one gets changed by this trait. - -=cut sub raw_clear_value { my ($self,$instance) = @_; @@ -299,12 +158,6 @@ sub raw_clear_value { ); } -=method C<store_multi_value> - -Gets the value from the regular slot in the instance, and stores it -into the multi-value object. - -=cut sub store_multi_value { my ($self,$instance,$opts) = @_; @@ -318,12 +171,6 @@ sub store_multi_value { our $dyn_opts = {}; -=method C<get_value> - -Before the normal method, calls L</load_multi_value>. Normally, no -options will be passed to the multi-value object C<get> method. - -=cut before get_value => sub { my ($self,$instance) = @_; @@ -331,14 +178,6 @@ before get_value => sub { $self->load_multi_value($instance,$dyn_opts); }; -=method C<get_multi_value> - -Sets the options that L</load_multi_value> will use, then calls L</get_value>. - -The options are passed via an ugly C<local>ised package -variable. There might be a better way. - -=cut sub get_multi_value { my ($self,$instance,$opts) = @_; @@ -348,11 +187,6 @@ sub get_multi_value { return $self->get_value($instance); } -=method C<set_initial_value> - -After the normal method, calls L</store_multi_value>. - -=cut after set_initial_value => sub { my ($self,$instance,$value) = @_; @@ -360,14 +194,6 @@ after set_initial_value => sub { $self->store_multi_value($instance,$dyn_opts); }; -=method C<set_value> - -=method C<set_multi_value> - -Just like L</get_value> and L</get_multi_value>, but calling -L</store_multi_value> after the regular C<set_value> - -=cut after set_value => sub { my ($self,$instance,$value) = @_; @@ -383,13 +209,6 @@ sub set_multi_value { return $self->set_value($instance,$value); } -=method C<has_value> - -=method C<has_multi_value> - -Just like L</get_value> and L</get_multi_value>. - -=cut before has_value => sub { my ($self,$instance) = @_; @@ -405,13 +224,6 @@ sub has_multi_value { return $self->has_value($instance); } -=method C<clear_value> - -=method C<clear_multi_value> - -Call the C<clear> method on the multi-value object. - -=cut after clear_value => sub { my ($self,$instance) = @_; @@ -428,14 +240,6 @@ sub clear_multi_value { return $self->clear_value($instance); } -=method C<get_multi_read_method> - -=method C<get_multi_write_method> - -Return the name of the reader or writer method, honoring -L</multi_reader>, L</multi_writer> and L</multi_accessor>. - -=cut sub get_multi_read_method { my $self = shift; @@ -449,18 +253,6 @@ sub get_multi_write_method { || $self->get_write_method . '_multi'; } -=head1 Serialisation helpers - -These are used through -L<Data::MultiValued::UglySerializationHelperRole>. - -=method C<_rebless_slot> - -Blesses the value inside the L</full_storage_slot> of the instance -into L</multivalue_storage_class>, then calls C<_rebless_storage> on -it. - -=cut sub _rebless_slot { my ($self,$instance) = @_; @@ -472,13 +264,6 @@ sub _rebless_slot { $st->_rebless_storage; } -=method C<_as_hash> - -Returns the result of calling C<_as_hash> on the value inside the -L</full_storage_slot> of the instance. Returns nothing if the slot -does not have a value. - -=cut sub _as_hash { my ($self,$instance) = @_; @@ -490,3 +275,232 @@ sub _as_hash { } 1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::AttributeTrait - "base role" for traits of multi-valued Moose attributes + +=head1 VERSION + +version 0.0.1_3 + +=head1 DESCRIPTION + +Don't use this role directly, use +L<Data::MultiValued::AttributeTrait::Tags>, +L<Data::MultiValued::AttributeTrait::Ranges> or +L<Data::MultiValued::AttributeTrait::TagsAndRanges>. + +This role (together with L<Data::MultiValued::AttributeAccessors>) +defines all the basic plumbing to glue C<Data::MultiValued::Tags> etc +into Moose attributes. + +=head1 ATTRIBUTES + +=head2 C<full_storage_slot> + +The instance slot to use to store the C<Data::MultiValued::Tags> or +similar object. Defaults to C<"${name}__MULTIVALUED_STORAGE__">, where +C<$name> is the attribute name. + +=head2 C<multi_accessor> + +=head2 C<multi_reader> + +=head2 C<multi_writer> + +=head2 C<multi_predicate> + +=head2 C<multi_clearer> + +The names to use for the various additional accessors. See +L<Class::MOP::Attribute> for details. These default to +C<"${name}_multi"> where C<$name> is the name of the corresponding +non-multi accessor. So, for example, + + has stuff => ( + is => 'rw', + traits => ['MultiValued::Tags'], + ); + +will create a C<stuff> read / write accessor and a C<stuff_multi> read +/ write tagged accessor. + +=head1 METHODS + +=head2 C<slots> + +Adds the L</full_storage_slot> to the list of used slots. + +=head2 C<set_full_storage> + +Stores a new instance of L</multivalue_storage_class> into the +L</full_storage_slot> of the instance. + +=head2 C<get_full_storage> + +Retrieves the value of the L</full_storage_slot> of the instance. + +=head2 C<full_storage> + +Returns an instance of L</multivalue_storage_class>, either by +retrieving it from the instance, or by creating one (and setting it in +the instance). Calls L</get_full_storage> and L</set_full_storage>. + +=head2 C<accessor_metaclass> + +Makes sure that all accessors for this attribute are created via the +L<Data::MultiValued::AttributeAccessors> method meta class. + +=head2 C<install_accessors> + +After the regular L<Moose::Meta::Attribute> method, installs the +multi-value accessors. + +Each installed normal accessor gets a multi-value version + +You can add or rename the multi-value version by using the attributes +described above + +If you are passing explicit subrefs for your accessors, things won't work. + +=head2 C<load_multi_value> + +Retrieves a value from the multi-value object, and stores it in the +regular slot in the instance. If the value is not found, clears the +slot. + +This traps the +L<Data::MultiValued::Exceptions::NotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::NotFound> +exception that may be thrown by the multi-value object, but re-throws +any other exception. + +=head2 C<raw_clear_value> + +Clears the instance slot. Does the same as +L<Moose::Meta::Attribute/clear_value>, but we need this method because +the other one gets changed by this trait. + +=head2 C<store_multi_value> + +Gets the value from the regular slot in the instance, and stores it +into the multi-value object. + +=head2 C<get_value> + +Before the normal method, calls L</load_multi_value>. Normally, no +options will be passed to the multi-value object C<get> method. + +=head2 C<get_multi_value> + +Sets the options that L</load_multi_value> will use, then calls L</get_value>. + +The options are passed via an ugly C<local>ised package +variable. There might be a better way. + +=head2 C<set_initial_value> + +After the normal method, calls L</store_multi_value>. + +=head2 C<set_value> + +=head2 C<set_multi_value> + +Just like L</get_value> and L</get_multi_value>, but calling +L</store_multi_value> after the regular C<set_value> + +=head2 C<has_value> + +=head2 C<has_multi_value> + +Just like L</get_value> and L</get_multi_value>. + +=head2 C<clear_value> + +=head2 C<clear_multi_value> + +Call the C<clear> method on the multi-value object. + +=head2 C<get_multi_read_method> + +=head2 C<get_multi_write_method> + +Return the name of the reader or writer method, honoring +L</multi_reader>, L</multi_writer> and L</multi_accessor>. + +=head2 C<_rebless_slot> + +Blesses the value inside the L</full_storage_slot> of the instance +into L</multivalue_storage_class>, then calls C<_rebless_storage> on +it. + +=head2 C<_as_hash> + +Returns the result of calling C<_as_hash> on the value inside the +L</full_storage_slot> of the instance. Returns nothing if the slot +does not have a value. + +=head1 ATTRIBUTES + +These are the attributes that this trait adds to the attribute in +your class. Example: + + has stuff => ( + is => 'rw', + isa => 'Int', + traits => ['MultiValued::Tags'], + predicate => 'has_stuff', + multi_accessor => 'stuff_tagged', + multi_predicate => 'has_stuff_tagged', + ); + +=head1 Implementation details + +The multi-value object is stored in the instance slot named by the +L</full_storage_slot> attribute attribute. C<before> modifiers on +getters load the appropriate value from the multi-value object into +the regular instance slot, C<after> modifiers on setters store the +value from the regular instance slot into the multi-value object. + +=head1 REQUIREMENTS + +These methods must be provided by any class consuming this role. See +L<Data::MultiValued::AttributeTrait::Tags> etc. for examples. + +=head2 C<multivalue_storage_class> + +The class to use to create the multi-value objects. + +=head2 C<opts_to_pass_set> + +Which options to pass from the multi-value accessors to the C<set> +method of the multi-value object. + +=head2 C<opts_to_pass_get> + +Which options to pass from the multi-value accessors to the C<get> +method of the multi-value object. + +=head1 Serialisation helpers + +These are used through +L<Data::MultiValued::UglySerializationHelperRole>. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Data/MultiValued/AttributeTrait/Ranges.pm b/lib/Data/MultiValued/AttributeTrait/Ranges.pm index 3d3b3f8..59d973c 100644 --- a/lib/Data/MultiValued/AttributeTrait/Ranges.pm +++ b/lib/Data/MultiValued/AttributeTrait/Ranges.pm @@ -1,10 +1,46 @@ package Data::MultiValued::AttributeTrait::Ranges; +{ + $Data::MultiValued::AttributeTrait::Ranges::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::AttributeTrait::Ranges::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::Ranges; with 'Data::MultiValued::AttributeTrait'; # ABSTRACT: attribute traits for attributes holding ranged values + +sub multivalue_storage_class { 'Data::MultiValued::Ranges' }; +sub opts_to_pass_set { qw(from to) } +sub opts_to_pass_get { qw(at) } + +package Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges; +{ + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges::VERSION = '0.0.1_3'; +} +{ + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges::DIST = 'Data-MultiValued'; +}{ +sub register_implementation { 'Data::MultiValued::AttributeTrait::Ranges' } +} + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::AttributeTrait::Ranges - attribute traits for attributes holding ranged values + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS package My::Class; @@ -38,14 +74,16 @@ Returns C<('from', 'to')>. Returns C<('at')>. -=cut +=head1 AUTHOR -sub multivalue_storage_class { 'Data::MultiValued::Ranges' }; -sub opts_to_pass_set { qw(from to) } -sub opts_to_pass_get { qw(at) } +Gianni Ceccarelli <dakkar@thenautilus.net> -package Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges;{ -sub register_implementation { 'Data::MultiValued::AttributeTrait::Ranges' } -} +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut -1; diff --git a/lib/Data/MultiValued/AttributeTrait/Tags.pm b/lib/Data/MultiValued/AttributeTrait/Tags.pm index d671ed4..d3124e2 100644 --- a/lib/Data/MultiValued/AttributeTrait/Tags.pm +++ b/lib/Data/MultiValued/AttributeTrait/Tags.pm @@ -1,10 +1,46 @@ package Data::MultiValued::AttributeTrait::Tags; +{ + $Data::MultiValued::AttributeTrait::Tags::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::AttributeTrait::Tags::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::Tags; with 'Data::MultiValued::AttributeTrait'; # ABSTRACT: attribute traits for attributes holding tagged values + +sub multivalue_storage_class { 'Data::MultiValued::Tags' }; +sub opts_to_pass_set { qw(tag) } +sub opts_to_pass_get { qw(tag) } + +package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags; +{ + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags::VERSION = '0.0.1_3'; +} +{ + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags::DIST = 'Data-MultiValued'; +}{ +sub register_implementation { 'Data::MultiValued::AttributeTrait::Tags' } +} + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::AttributeTrait::Tags - attribute traits for attributes holding tagged values + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS package My::Class; @@ -38,14 +74,16 @@ Returns C<('tag')>. Returns C<('tag')>. -=cut +=head1 AUTHOR -sub multivalue_storage_class { 'Data::MultiValued::Tags' }; -sub opts_to_pass_set { qw(tag) } -sub opts_to_pass_get { qw(tag) } +Gianni Ceccarelli <dakkar@thenautilus.net> -package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags;{ -sub register_implementation { 'Data::MultiValued::AttributeTrait::Tags' } -} +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut -1; diff --git a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm index 0bb87ef..7bf362f 100644 --- a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm +++ b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm @@ -1,10 +1,46 @@ package Data::MultiValued::AttributeTrait::TagsAndRanges; +{ + $Data::MultiValued::AttributeTrait::TagsAndRanges::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::AttributeTrait::TagsAndRanges::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::TagsAndRanges; with 'Data::MultiValued::AttributeTrait'; # ABSTRACT: attribute traits for attributes holding tagged and ranged values + +sub multivalue_storage_class { 'Data::MultiValued::TagsAndRanges' }; +sub opts_to_pass_set { qw(from to tag) } +sub opts_to_pass_get { qw(at tag) } + +package Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges; +{ + $Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges::VERSION = '0.0.1_3'; +} +{ + $Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges::DIST = 'Data-MultiValued'; +}{ +sub register_implementation { 'Data::MultiValued::AttributeTrait::TagsAndRanges' } +} + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::AttributeTrait::TagsAndRanges - attribute traits for attributes holding tagged and ranged values + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS package My::Class; @@ -38,14 +74,16 @@ Returns C<('tag', 'from', 'to')>. Returns C<('tag', 'at')>. -=cut +=head1 AUTHOR -sub multivalue_storage_class { 'Data::MultiValued::TagsAndRanges' }; -sub opts_to_pass_set { qw(from to tag) } -sub opts_to_pass_get { qw(at tag) } +Gianni Ceccarelli <dakkar@thenautilus.net> -package Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges;{ -sub register_implementation { 'Data::MultiValued::AttributeTrait::TagsAndRanges' } -} +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut -1; diff --git a/lib/Data/MultiValued/Exceptions.pm b/lib/Data/MultiValued/Exceptions.pm index 6495780..c908388 100644 --- a/lib/Data/MultiValued/Exceptions.pm +++ b/lib/Data/MultiValued/Exceptions.pm @@ -1,22 +1,21 @@ package Data::MultiValued::Exceptions; +{ + $Data::MultiValued::Exceptions::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Exceptions::DIST = 'Data-MultiValued'; +} # ABSTRACT: exception classes -=head1 DESCRIPTION - -This module defines a few exception classes, using L<Throwable::Error> -as a base class. - -=head1 CLASSES - -=head2 C<Data::MultiValued::Exceptions::NotFound> -Base class for "not found" errors. Has a C<value> attribute, -containing the value that was not found. - -=cut - -package Data::MultiValued::Exceptions::NotFound;{ +package Data::MultiValued::Exceptions::NotFound; +{ + $Data::MultiValued::Exceptions::NotFound::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Exceptions::NotFound::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Throwable::Error'; @@ -35,18 +34,14 @@ sub as_string { } } -=head2 C<Data::MultiValued::Exceptions::TagNotFound> -Subclass of L</Data::MultiValued::Exceptions::NotFound>, for -tags. Stringifies to: - - tag not found: $value - - $stack_trace - -=cut - -package Data::MultiValued::Exceptions::TagNotFound;{ +package Data::MultiValued::Exceptions::TagNotFound; +{ + $Data::MultiValued::Exceptions::TagNotFound::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Exceptions::TagNotFound::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Data::MultiValued::Exceptions::NotFound'; @@ -55,18 +50,14 @@ has '+message' => ( ); } -=head2 C<Data::MultiValued::Exceptions::RangeNotFound> - -Subclass of L</Data::MultiValued::Exceptions::NotFound>, for -ranges. Stringifies to: - no range found for value: $value - - $stack_trace - -=cut - -package Data::MultiValued::Exceptions::RangeNotFound;{ +package Data::MultiValued::Exceptions::RangeNotFound; +{ + $Data::MultiValued::Exceptions::RangeNotFound::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Exceptions::RangeNotFound::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Data::MultiValued::Exceptions::NotFound'; @@ -75,20 +66,14 @@ has '+message' => ( ); } -=head2 C<Data::MultiValued::Exceptions::BadRange> - -Thrown when an invalid range is supplied to a method. An invalid range -is a range with C<from> greater than C<to>. - -Stringifies to: - invalid range: $from, $to - - $stack_trace - -=cut - -package Data::MultiValued::Exceptions::BadRange;{ +package Data::MultiValued::Exceptions::BadRange; +{ + $Data::MultiValued::Exceptions::BadRange::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Exceptions::BadRange::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Throwable::Error'; @@ -109,3 +94,71 @@ sub as_string { } 1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::Exceptions - exception classes + +=head1 VERSION + +version 0.0.1_3 + +=head1 DESCRIPTION + +This module defines a few exception classes, using L<Throwable::Error> +as a base class. + +=head1 CLASSES + +=head2 C<Data::MultiValued::Exceptions::NotFound> + +Base class for "not found" errors. Has a C<value> attribute, +containing the value that was not found. + +=head2 C<Data::MultiValued::Exceptions::TagNotFound> + +Subclass of L</Data::MultiValued::Exceptions::NotFound>, for +tags. Stringifies to: + + tag not found: $value + + $stack_trace + +=head2 C<Data::MultiValued::Exceptions::RangeNotFound> + +Subclass of L</Data::MultiValued::Exceptions::NotFound>, for +ranges. Stringifies to: + + no range found for value: $value + + $stack_trace + +=head2 C<Data::MultiValued::Exceptions::BadRange> + +Thrown when an invalid range is supplied to a method. An invalid range +is a range with C<from> greater than C<to>. + +Stringifies to: + + invalid range: $from, $to + + $stack_trace + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Data/MultiValued/RangeContainer.pm b/lib/Data/MultiValued/RangeContainer.pm index a444150..96ce9d9 100644 --- a/lib/Data/MultiValued/RangeContainer.pm +++ b/lib/Data/MultiValued/RangeContainer.pm @@ -1,4 +1,10 @@ package Data::MultiValued::RangeContainer; +{ + $Data::MultiValued::RangeContainer::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::RangeContainer::DIST = 'Data-MultiValued'; +} use Moose; use Moose::Util::TypeConstraints; use MooseX::Types::Moose qw(Num Str Any Undef ArrayRef); @@ -7,24 +13,6 @@ use Data::MultiValued::Exceptions; # ABSTRACT: container for ranged values -=head1 DESCRIPTION - -Please don't use this module directly, use L<Data::MultiValued::Ranges>. - -This module implements the storage for ranged data. It's similar to -L<Array::IntSpan>, but simpler (and slower). - -A range is defined by a pair of numbers, C<from> and C<to>, and it -contains C<< Num $x : $min <= $x < $max >>. C<undef> is treated as -"inf" (negative infinity if used as C<from> or C<at>, positive -infinity if used as C<to>). - -The internal representation of a range is a hash with three keys, -C<from> C<to> C<value>. - -=head1 METHODS - -=cut has _storage => ( is => 'rw', @@ -39,15 +27,6 @@ has _storage => ( default => sub { [ ] }, ); -=head2 C<get> - - my $value = $obj->get({ at => $point }); - -Retrieves the range that includes the given point. Throws a -L<Data::MultiValued::Exceptions::RangeNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::RangeNotFound> -exception if no range includes the point. - -=cut sub get { my ($self,$args) = @_; @@ -117,17 +96,6 @@ sub _partition_slots { return \@before,\@overlap,\@after; } -=head2 C<get_or_create> - - $obj->get_or_create({ from => $min, to => $max }); - -Retrieves the range that has the given extremes. If no such range -exists, creates a new range, splicing any existing overlapping range, -and returns it. Throws -L<Data::MultiValued::Exceptions::BadRange|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::BadRange> -if C<< $min > $max >>. - -=cut sub get_or_create { my ($self,$args) = @_; @@ -152,20 +120,6 @@ sub get_or_create { return $range; } -=head2 C<clear> - - $obj->clear({ from => $min, to => $max }); - -Removes the range that has the given extremes. If no such range -exists, splices any existing overlapping range so that C<< -$obj->get({at => $point }) >> for any C<< $min <= $point < $max >> -will die. - -Throws -L<Data::MultiValued::Exceptions::BadRange|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::BadRange> -if C<< $min > $max >>. - -=cut sub clear { my ($self,$args) = @_; @@ -271,6 +225,76 @@ sub _splice_slot { return $new; } + +sub all_ranges { + my ($self) = @_; + + return map { [ $_->{from}, $_->{to} ] } @{$self->_storage}; +} + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::RangeContainer - container for ranged values + +=head1 VERSION + +version 0.0.1_3 + +=head1 DESCRIPTION + +Please don't use this module directly, use L<Data::MultiValued::Ranges>. + +This module implements the storage for ranged data. It's similar to +L<Array::IntSpan>, but simpler (and slower). + +A range is defined by a pair of numbers, C<from> and C<to>, and it +contains C<< Num $x : $min <= $x < $max >>. C<undef> is treated as +"inf" (negative infinity if used as C<from> or C<at>, positive +infinity if used as C<to>). + +The internal representation of a range is a hash with three keys, +C<from> C<to> C<value>. + +=head1 METHODS + +=head2 C<get> + + my $value = $obj->get({ at => $point }); + +Retrieves the range that includes the given point. Throws a +L<Data::MultiValued::Exceptions::RangeNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::RangeNotFound> +exception if no range includes the point. + +=head2 C<get_or_create> + + $obj->get_or_create({ from => $min, to => $max }); + +Retrieves the range that has the given extremes. If no such range +exists, creates a new range, splicing any existing overlapping range, +and returns it. Throws +L<Data::MultiValued::Exceptions::BadRange|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::BadRange> +if C<< $min > $max >>. + +=head2 C<clear> + + $obj->clear({ from => $min, to => $max }); + +Removes the range that has the given extremes. If no such range +exists, splices any existing overlapping range so that C<< +$obj->get({at => $point }) >> for any C<< $min <= $point < $max >> +will die. + +Throws +L<Data::MultiValued::Exceptions::BadRange|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::BadRange> +if C<< $min > $max >>. + =head2 C<all_ranges> my @ranges = $obj->all_ranges; @@ -278,12 +302,16 @@ sub _splice_slot { Returns all the ranges defined in this object, as a list of 2-elements arrayrefs. -=cut +=head1 AUTHOR -sub all_ranges { - my ($self) = @_; +Gianni Ceccarelli <dakkar@thenautilus.net> - return map { [ $_->{from}, $_->{to} ] } @{$self->_storage}; -} +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut -1; diff --git a/lib/Data/MultiValued/Ranges.pm b/lib/Data/MultiValued/Ranges.pm index 3da1594..db863a5 100644 --- a/lib/Data/MultiValued/Ranges.pm +++ b/lib/Data/MultiValued/Ranges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::Ranges; +{ + $Data::MultiValued::Ranges::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Ranges::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Params::Validate; use Moose::Util::TypeConstraints; @@ -8,6 +14,85 @@ use Data::MultiValued::RangeContainer; # ABSTRACT: Handle values with 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->get_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,%args) = validated_hash( + \@_, + from => { isa => Num|Undef, optional => 1, }, + to => { isa => Num|Undef, optional => 1, }, + ); + + $self->_storage->clear(\%args); +} + + +sub _rebless_storage { + my ($self) = @_; + + bless $self->{_storage},'Data::MultiValued::RangeContainer'; +} + + + +sub _as_hash { + my ($self) = @_; + + my %ret = %{$self->_storage}; + return {_storage=>\%ret}; +} + + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::Ranges - Handle values with validity ranges + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS use Data::MultiValued::Ranges; @@ -23,19 +108,6 @@ use Data::MultiValued::RangeContainer; =head1 METHODS -=cut - -has _storage => ( - is => 'rw', - isa => class_type('Data::MultiValued::RangeContainer'), - init_arg => undef, - lazy_build => 1, -); - -sub _build__storage { - Data::MultiValued::RangeContainer->new(); -} - =head2 C<set> $obj->set({ from => $min, to => $max, value => $the_value }); @@ -69,20 +141,6 @@ avoid overlaps. In other words: No cloning is done: if you pass in a reference, the reference is just stored. -=cut - -sub set { - my ($self,%args) = validated_hash( - \@_, - from => { isa => Num|Undef, optional => 1, }, - to => { isa => Num|Undef, optional => 1, }, - value => { isa => Any, }, - ); - - $self->_storage->get_or_create(\%args) - ->{value} = $args{value}; -} - =head2 C<get> my $value = $obj->get({ at => $point }); @@ -98,18 +156,6 @@ equivalent to passing C<undef>. No cloning is done: if a reference was stored, you get it back untouched. -=cut - -sub get { - my ($self,%args) = validated_hash( - \@_, - at => { isa => Num|Undef, optional => 1, }, - ); - - $self->_storage->get(\%args) - ->{value}; -} - =head2 C<clear> $obj->clear({ from => $min, to => $max }); @@ -137,18 +183,6 @@ other words: say $obj->get({at => 12}); # prints 'foo' say $obj->get({at => 15}); # dies -=cut - -sub clear { - my ($self,%args) = validated_hash( - \@_, - from => { isa => Num|Undef, optional => 1, }, - to => { isa => Num|Undef, optional => 1, }, - ); - - $self->_storage->clear(\%args); -} - =head1 Serialisation helpers These are used through @@ -158,33 +192,25 @@ L<Data::MultiValued::UglySerializationHelperRole>. Blesses the storage into L<Data::MultiValued::RangeContainer>. -=cut - -sub _rebless_storage { - my ($self) = @_; - - bless $self->{_storage},'Data::MultiValued::RangeContainer'; -} - - =head2 C<_as_hash> Returns the internal representation with no blessed hashes, with as few copies as possible. -=cut +=head1 SEE ALSO -sub _as_hash { - my ($self) = @_; +L<Data::MultiValued::RangeContainer>, L<Data::MultiValued::Exceptions> - my %ret = %{$self->_storage}; - return {_storage=>\%ret}; -} +=head1 AUTHOR -=head1 SEE ALSO +Gianni Ceccarelli <dakkar@thenautilus.net> -L<Data::MultiValued::RangeContainer>, L<Data::MultiValued::Exceptions> +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. =cut -1; diff --git a/lib/Data/MultiValued/TagContainer.pm b/lib/Data/MultiValued/TagContainer.pm index f6e5551..4ba40df 100644 --- a/lib/Data/MultiValued/TagContainer.pm +++ b/lib/Data/MultiValued/TagContainer.pm @@ -1,4 +1,10 @@ package Data::MultiValued::TagContainer; +{ + $Data::MultiValued::TagContainer::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::TagContainer::DIST = 'Data-MultiValued'; +} use Moose; use Moose::Util::TypeConstraints; use MooseX::Types::Moose qw(HashRef); @@ -6,23 +12,6 @@ use Data::MultiValued::Exceptions; # ABSTRACT: container for tagged values -=head1 DESCRIPTION - -Please don't use this module directly, use L<Data::MultiValued::Tags>. - -This module implements the storage for tagged data. It's almost -exactly a hash, the main difference being that C<undef> is a valid key -and it's distinct from the empty string. - -Another difference is that you get an exception if you try to access a -tag that's not there. - -Data is kept in "storage cells", as created by -L</_create_new_inferior> (by default, a hashref). - -=head1 METHODS - -=cut has _storage => ( is => 'rw', @@ -46,18 +35,6 @@ has _default_tag => ( clearer => '_clear_default_tag', ); -=head2 C<get> - - my $value = $obj->get({ tag => $the_tag }); - -Retrieves the "storage cell" for the given tag. Throws a -L<Data::MultiValued::Exceptions::TagNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::TagNotFound> -exception if the tag does not exists in this object. - -Not passing in a C<tag> is equivalent to passing in C<< tag => undef ->>. - -=cut sub get { my ($self,$args) = @_; @@ -82,18 +59,6 @@ sub get { return $self->_get_tag($tag); } -=head2 C<get_or_create> - - $obj->get_or_create({ tag => $the_tag }); - -Retrieves the "storage cell" for the given tag. If the tag does not -exist, creates a new cell (see L</_create_new_inferior>), sets it for -the tag, and returns it. - -Not passing in a C<tag> is equivalent to passing in C<< tag => undef ->>. - -=cut sub get_or_create { my ($self,$args) = @_; @@ -123,18 +88,6 @@ sub _clear_storage { $self->_storage({}); } -=head2 C<clear> - - $obj->clear({ tag => $the_tag }); - -Deletes the given tag and all data associated with it. Does not throw -exceptions: if the tag does not exist, nothing happens. - -Not passing in a C<tag>, or passing C<< tag => undef >>, clears -everything. If you want to only clear the C<undef> tag, you may call -C<_clear_default_tag> (which is considered a "protected" method). - -=cut sub clear { my ($self,$args) = @_; @@ -151,6 +104,76 @@ sub clear { return; } + +sub _create_new_inferior { + my ($self) = @_; + return {}; +} + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::TagContainer - container for tagged values + +=head1 VERSION + +version 0.0.1_3 + +=head1 DESCRIPTION + +Please don't use this module directly, use L<Data::MultiValued::Tags>. + +This module implements the storage for tagged data. It's almost +exactly a hash, the main difference being that C<undef> is a valid key +and it's distinct from the empty string. + +Another difference is that you get an exception if you try to access a +tag that's not there. + +Data is kept in "storage cells", as created by +L</_create_new_inferior> (by default, a hashref). + +=head1 METHODS + +=head2 C<get> + + my $value = $obj->get({ tag => $the_tag }); + +Retrieves the "storage cell" for the given tag. Throws a +L<Data::MultiValued::Exceptions::TagNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::TagNotFound> +exception if the tag does not exists in this object. + +Not passing in a C<tag> is equivalent to passing in C<< tag => undef +>>. + +=head2 C<get_or_create> + + $obj->get_or_create({ tag => $the_tag }); + +Retrieves the "storage cell" for the given tag. If the tag does not +exist, creates a new cell (see L</_create_new_inferior>), sets it for +the tag, and returns it. + +Not passing in a C<tag> is equivalent to passing in C<< tag => undef +>>. + +=head2 C<clear> + + $obj->clear({ tag => $the_tag }); + +Deletes the given tag and all data associated with it. Does not throw +exceptions: if the tag does not exist, nothing happens. + +Not passing in a C<tag>, or passing C<< tag => undef >>, clears +everything. If you want to only clear the C<undef> tag, you may call +C<_clear_default_tag> (which is considered a "protected" method). + =head2 C<all_tags> my @tags = $obj->all_tags; @@ -163,11 +186,16 @@ C<undef> tag. Returns a new "storage cell", by default an empty hashref. See L<Data::MultiValued::TagContainerForRanges> for an example of use. -=cut +=head1 AUTHOR -sub _create_new_inferior { - my ($self) = @_; - return {}; -} +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut -1; diff --git a/lib/Data/MultiValued/TagContainerForRanges.pm b/lib/Data/MultiValued/TagContainerForRanges.pm index 826df9d..115276b 100644 --- a/lib/Data/MultiValued/TagContainerForRanges.pm +++ b/lib/Data/MultiValued/TagContainerForRanges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::TagContainerForRanges; +{ + $Data::MultiValued::TagContainerForRanges::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::TagContainerForRanges::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Types::Moose qw(HashRef); use Moose::Util::TypeConstraints; @@ -6,18 +12,6 @@ use Data::MultiValued::RangeContainer; # ABSTRACT: container for tagged values that are ranged containers -=head1 DESCRIPTION - -Please don't use this module directly, use -L<Data::MultiValued::TagsAndRanges>. - -This module is a subclass of L<Data::MultiValued::TagContainer>, which -only allows instances of L<Data::MultiValued::RangeContainer> as -"storage cells". - -=head1 METHODS - -=cut extends 'Data::MultiValued::TagContainer'; @@ -29,26 +23,11 @@ has '+_default_tag' => ( isa => class_type('Data::MultiValued::RangeContainer'), ); -=head2 C<_create_new_inferior> - -Returns a new L<Data::MultiValued::RangeContainer> instance. - -=cut sub _create_new_inferior { Data::MultiValued::RangeContainer->new(); } -=head1 Serialisation helpers - -These are used through -L<Data::MultiValued::UglySerializationHelperRole>. - -=head2 C<_rebless_storage> - -Blesses the "storage cells" into L<Data::MultiValued::RangeContainer>. - -=cut sub _rebless_storage { my ($self) = @_; @@ -58,12 +37,6 @@ sub _rebless_storage { return; } -=head2 C<_as_hash> - -Returns the internal representation with no blessed hashes, with as -few copies as possible. - -=cut sub _as_hash { my ($self) = @_; @@ -80,3 +53,59 @@ sub _as_hash { } 1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::TagContainerForRanges - container for tagged values that are ranged containers + +=head1 VERSION + +version 0.0.1_3 + +=head1 DESCRIPTION + +Please don't use this module directly, use +L<Data::MultiValued::TagsAndRanges>. + +This module is a subclass of L<Data::MultiValued::TagContainer>, which +only allows instances of L<Data::MultiValued::RangeContainer> as +"storage cells". + +=head1 METHODS + +=head2 C<_create_new_inferior> + +Returns a new L<Data::MultiValued::RangeContainer> instance. + +=head1 Serialisation helpers + +These are used through +L<Data::MultiValued::UglySerializationHelperRole>. + +=head2 C<_rebless_storage> + +Blesses the "storage cells" into L<Data::MultiValued::RangeContainer>. + +=head2 C<_as_hash> + +Returns the internal representation with no blessed hashes, with as +few copies as possible. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm index 59ebbf5..ccf6e52 100644 --- a/lib/Data/MultiValued/Tags.pm +++ b/lib/Data/MultiValued/Tags.pm @@ -1,4 +1,10 @@ package Data::MultiValued::Tags; +{ + $Data::MultiValued::Tags::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Tags::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Params::Validate; use Moose::Util::TypeConstraints; @@ -8,6 +14,82 @@ use Data::MultiValued::TagContainer; # ABSTRACT: Handle values with tags + +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,%args) = validated_hash( + \@_, + tag => { isa => Str, optional => 1, }, + ); + + $self->_storage->clear(\%args); +} + + +sub _rebless_storage { + my ($self) = @_; + + bless $self->{_storage},'Data::MultiValued::TagContainer'; +} + + +sub _as_hash { + my ($self) = @_; + + my %ret = %{$self->_storage}; + return {_storage=>\%ret}; +} + + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::Tags - Handle values with tags + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS use Data::MultiValued::Tags; @@ -22,19 +104,6 @@ use Data::MultiValued::TagContainer; =head1 METHODS -=cut - -has _storage => ( - is => 'rw', - isa => class_type('Data::MultiValued::TagContainer'), - init_arg => undef, - lazy_build => 1, -); - -sub _build__storage { - Data::MultiValued::TagContainer->new(); -} - =head2 C<set> $obj->set({ tag => $the_tag, value => $the_value }); @@ -48,19 +117,6 @@ Not passing in a C<tag> is equivalent to passing in C<< tag => undef No cloning is done: if you pass in a reference, the reference is just stored. -=cut - -sub set { - my ($self,%args) = validated_hash( - \@_, - tag => { isa => Str, optional => 1, }, - value => { isa => Any, }, - ); - - $self->_storage->get_or_create(\%args) - ->{value} = $args{value}; -} - =head2 C<get> my $value = $obj->get({ tag => $the_tag }); @@ -75,18 +131,6 @@ Not passing in a C<tag> is equivalent to passing in C<< tag => undef No cloning is done: if a reference was stored, you get it back untouched. -=cut - -sub get { - my ($self,%args) = validated_hash( - \@_, - tag => { isa => Str, optional => 1, }, - ); - - $self->_storage->get(\%args) - ->{value}; -} - =head2 C<clear> $obj->clear({ tag => $the_tag }); @@ -97,17 +141,6 @@ exceptions: if the tag does not exist, nothing happens. Not passing in a C<tag> clears everything. Yes, this means that there is no way to just clear the value for the C<undef> tag. -=cut - -sub clear { - my ($self,%args) = validated_hash( - \@_, - tag => { isa => Str, optional => 1, }, - ); - - $self->_storage->clear(\%args); -} - =head1 Serialisation helpers These are used through @@ -117,32 +150,25 @@ L<Data::MultiValued::UglySerializationHelperRole>. Blesses the storage into L<Data::MultiValued::TagContainer>. -=cut - -sub _rebless_storage { - my ($self) = @_; - - bless $self->{_storage},'Data::MultiValued::TagContainer'; -} - =head2 C<_as_hash> Returns the internal representation with no blessed hashes, with as few copies as possible. -=cut +=head1 SEE ALSO -sub _as_hash { - my ($self) = @_; +L<Data::MultiValued::TagContainer>, L<Data::MultiValued::Exceptions> - my %ret = %{$self->_storage}; - return {_storage=>\%ret}; -} +=head1 AUTHOR -=head1 SEE ALSO +Gianni Ceccarelli <dakkar@thenautilus.net> -L<Data::MultiValued::TagContainer>, L<Data::MultiValued::Exceptions> +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. =cut -1; diff --git a/lib/Data/MultiValued/TagsAndRanges.pm b/lib/Data/MultiValued/TagsAndRanges.pm index 60333c8..fd1461e 100644 --- a/lib/Data/MultiValued/TagsAndRanges.pm +++ b/lib/Data/MultiValued/TagsAndRanges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::TagsAndRanges; +{ + $Data::MultiValued::TagsAndRanges::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::TagsAndRanges::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Params::Validate; use Moose::Util::TypeConstraints; @@ -8,24 +14,6 @@ use Data::MultiValued::TagContainerForRanges; # ABSTRACT: Handle values with tags and validity ranges -=head1 SYNOPSIS - - use Data::MultiValued::TagsAndRanges; - - my $obj = Data::MultiValued::TagsAndRanges->new(); - $obj->set({ - tag => 'tag1', - from => 10, - to => 20, - value => 'foo', - }); - say $obj->get({tag => 'tag1', at => 15}); # prints 'foo' - say $obj->get({tag => 'tag1', at => 35}); # dies - say $obj->get({tag => 'tag2', at => 15}); # dies - -=head1 METHODS - -=cut has _storage => ( is => 'rw', @@ -38,17 +26,6 @@ sub _build__storage { Data::MultiValued::TagContainerForRanges->new(); } -=head2 C<set> - - $obj->set({ tag => $the_tag, from => $min, to => $max, value => $the_value }); - -Stores the given value for the given tag and range. Does not throw -exceptions. - -See L<Data::MultiValued::Tags/set> and -L<Data::MultiValued::Ranges/set> for more details. - -=cut sub set { my ($self,%args) = validated_hash( @@ -64,21 +41,6 @@ sub set { ->{value} = $args{value}; } -=head2 C<get> - - my $value = $obj->get({ tag => $the_tag, at => $point }); - -Retrieves the value for the given tag and point. Throws a -L<Data::MultiValued::Exceptions::RangeNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::RangeNotFound> -exception if no ranges exist in this object that include the point, -and -L<Data::MultiValued::Exceptions::TagNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::TagNotFound> -exception if the tag does not exists in this object. - -See L<Data::MultiValued::Tags/get> and -L<Data::MultiValued::Ranges/get> for more details. - -=cut sub get { my ($self,%args) = validated_hash( @@ -92,19 +54,6 @@ sub get { ->{value}; } -=head2 C<clear> - - $obj->clear({ tag => $the_tag, from => $min, to => $max }); - -If a range is specified, deletes all values for the given range and -tag. If no range is specified, delete all values for the given tag. - -Does not throw exceptions. - -See L<Data::MultiValued::Tags/clear> and -L<Data::MultiValued::Ranges/clear> for more details. - -=cut sub clear { my ($self,%args) = validated_hash( @@ -123,6 +72,90 @@ sub clear { } } + +sub _rebless_storage { + my ($self) = @_; + + bless $self->{_storage},'Data::MultiValued::TagContainerForRanges'; + $self->_storage->_rebless_storage; +} + + +sub _as_hash { + my ($self) = @_; + + my $ret = $self->_storage->_as_hash; + return {_storage=>$ret}; +} + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::TagsAndRanges - Handle values with tags and validity ranges + +=head1 VERSION + +version 0.0.1_3 + +=head1 SYNOPSIS + + use Data::MultiValued::TagsAndRanges; + + my $obj = Data::MultiValued::TagsAndRanges->new(); + $obj->set({ + tag => 'tag1', + from => 10, + to => 20, + value => 'foo', + }); + say $obj->get({tag => 'tag1', at => 15}); # prints 'foo' + say $obj->get({tag => 'tag1', at => 35}); # dies + say $obj->get({tag => 'tag2', at => 15}); # dies + +=head1 METHODS + +=head2 C<set> + + $obj->set({ tag => $the_tag, from => $min, to => $max, value => $the_value }); + +Stores the given value for the given tag and range. Does not throw +exceptions. + +See L<Data::MultiValued::Tags/set> and +L<Data::MultiValued::Ranges/set> for more details. + +=head2 C<get> + + my $value = $obj->get({ tag => $the_tag, at => $point }); + +Retrieves the value for the given tag and point. Throws a +L<Data::MultiValued::Exceptions::RangeNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::RangeNotFound> +exception if no ranges exist in this object that include the point, +and +L<Data::MultiValued::Exceptions::TagNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::TagNotFound> +exception if the tag does not exists in this object. + +See L<Data::MultiValued::Tags/get> and +L<Data::MultiValued::Ranges/get> for more details. + +=head2 C<clear> + + $obj->clear({ tag => $the_tag, from => $min, to => $max }); + +If a range is specified, deletes all values for the given range and +tag. If no range is specified, delete all values for the given tag. + +Does not throw exceptions. + +See L<Data::MultiValued::Tags/clear> and +L<Data::MultiValued::Ranges/clear> for more details. + =head1 Serialisation helpers These are used through @@ -133,28 +166,22 @@ L<Data::MultiValued::UglySerializationHelperRole>. Blesses the storage into L<Data::MultiValued::TagContainerForRanges>, then calls C<_rebless_storage> on it. -=cut - -sub _rebless_storage { - my ($self) = @_; - - bless $self->{_storage},'Data::MultiValued::TagContainerForRanges'; - $self->_storage->_rebless_storage; -} - =head2 C<_as_hash> Returns the internal representation with no blessed hashes, with as few copies as possible. Depends on L<Data::MultiValued::TagContainerForRanges/_as_hash>. -=cut +=head1 AUTHOR -sub _as_hash { - my ($self) = @_; +Gianni Ceccarelli <dakkar@thenautilus.net> - my $ret = $self->_storage->_as_hash; - return {_storage=>$ret}; -} +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut -1; diff --git a/lib/Data/MultiValued/UglySerializationHelperRole.pm b/lib/Data/MultiValued/UglySerializationHelperRole.pm index 0c06ac6..c30166f 100644 --- a/lib/Data/MultiValued/UglySerializationHelperRole.pm +++ b/lib/Data/MultiValued/UglySerializationHelperRole.pm @@ -1,8 +1,63 @@ package Data::MultiValued::UglySerializationHelperRole; +{ + $Data::MultiValued::UglySerializationHelperRole::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::UglySerializationHelperRole::DIST = 'Data-MultiValued'; +} use Moose::Role; # ABSTRACT: only use this if you know what you're doing + +sub new_in_place { + my ($class,$hash) = @_; + + my $self = bless $hash,$class; + + for my $attr ($class->meta->get_all_attributes) { + if ($attr->does('Data::MultiValued::AttributeTrait')) { + $attr->_rebless_slot($self); + } + } + return $self; +} + + +sub as_hash { + my ($self) = @_; + + my %ret = %$self; + for my $attr ($self->meta->get_all_attributes) { + if ($attr->does('Data::MultiValued::AttributeTrait')) { + my $st = $attr->_as_hash($self); + if ($st) { + $ret{$attr->full_storage_slot} = $st; + } + else { + delete $ret{$attr->full_storage_slot}; + } + } + } + return \%ret; +} + + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::UglySerializationHelperRole - only use this if you know what you're doing + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS package My::Class; @@ -54,21 +109,6 @@ C<_rebless_slot> on any multi-value attribute. This is very dangerous, don't try this at home without the supervision of an adult. -=cut - -sub new_in_place { - my ($class,$hash) = @_; - - my $self = bless $hash,$class; - - for my $attr ($class->meta->get_all_attributes) { - if ($attr->does('Data::MultiValued::AttributeTrait')) { - $attr->_rebless_slot($self); - } - } - return $self; -} - =head2 C<as_hash> my $hashref = $obj->as_hash; @@ -80,26 +120,6 @@ on the corresponding multi-value attribute. This is very dangerous, don't try this at home without the supervision of an adult. -=cut - -sub as_hash { - my ($self) = @_; - - my %ret = %$self; - for my $attr ($self->meta->get_all_attributes) { - if ($attr->does('Data::MultiValued::AttributeTrait')) { - my $st = $attr->_as_hash($self); - if ($st) { - $ret{$attr->full_storage_slot} = $st; - } - else { - delete $ret{$attr->full_storage_slot}; - } - } - } - return \%ret; -} - =head1 FINAL WARNING my $obj_clone = My::Class->new_in_place($obj->as_hash); @@ -108,6 +128,16 @@ This will create a shallow clone. Most internals will be shared. Things may break. Just don't do it, C<dclone> the hashref, or do something equivalent (as in the synopsis), instead. +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + =cut -1; diff --git a/t/release-no-tabs.t b/t/release-no-tabs.t new file mode 100644 index 0000000..1c7204e --- /dev/null +++ b/t/release-no-tabs.t @@ -0,0 +1,16 @@ + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + +use strict; +use warnings; +use Test::More; + +eval 'use Test::NoTabs'; +plan skip_all => 'Test::NoTabs required' if $@; + +all_perl_files_ok(); diff --git a/t/release-pod-coverage.t b/t/release-pod-coverage.t new file mode 100644 index 0000000..3a81849 --- /dev/null +++ b/t/release-pod-coverage.t @@ -0,0 +1,21 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +use Test::More; + +eval "use Test::Pod::Coverage 1.08"; +plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" + if $@; + +eval "use Pod::Coverage::TrustPod"; +plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" + if $@; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/t/release-pod-syntax.t b/t/release-pod-syntax.t new file mode 100644 index 0000000..d46a955 --- /dev/null +++ b/t/release-pod-syntax.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + +use Test::More; + +eval "use Test::Pod 1.41"; +plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; + +all_pod_files_ok(); |