diff options
Diffstat (limited to 'lib/Data/MultiValued/UglySerializationHelperRole.pm')
-rw-r--r-- | lib/Data/MultiValued/UglySerializationHelperRole.pm | 108 |
1 files changed, 70 insertions, 38 deletions
diff --git a/lib/Data/MultiValued/UglySerializationHelperRole.pm b/lib/Data/MultiValued/UglySerializationHelperRole.pm index ebf783a..9913a7d 100644 --- a/lib/Data/MultiValued/UglySerializationHelperRole.pm +++ b/lib/Data/MultiValued/UglySerializationHelperRole.pm @@ -1,9 +1,64 @@ package Data::MultiValued::UglySerializationHelperRole; +{ + $Data::MultiValued::UglySerializationHelperRole::VERSION = '0.0.3'; +} +{ + $Data::MultiValued::UglySerializationHelperRole::DIST = 'Data-MultiValued'; +} use Moose::Role; use namespace::autoclean; # 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.3 + =head1 SYNOPSIS package My::Class; @@ -43,7 +98,9 @@ copies. Oh, and on de-serialise it will skip all type constraint checking and bypass the accessors, so it may well give you an unusable object. -=method C<new_in_place> +=head1 METHODS + +=head2 C<new_in_place> my $obj = My::Class->new_in_place($hashref); @@ -53,22 +110,7 @@ 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; -} - -=method C<as_hash> +=head2 C<as_hash> my $hashref = $obj->as_hash; @@ -79,26 +121,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); @@ -107,6 +129,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; |