Commit | Line | Data |
3fea05b9 |
1 | #!/usr/bin/perl |
2 | |
3 | package MooseX::Clone::Meta::Attribute::Trait::Copy; |
4 | use Moose::Role; |
5 | |
6 | use Carp qw(croak); |
7 | |
8 | use namespace::clean -except => 'meta'; |
9 | |
10 | with qw(MooseX::Clone::Meta::Attribute::Trait::Clone::Base); |
11 | |
12 | sub Moose::Meta::Attribute::Custom::Trait::Copy::register_implementation { __PACKAGE__ } |
13 | |
14 | sub clone_value { |
15 | my ( $self, $target, $proto, %args ) = @_; |
16 | |
17 | return unless $self->has_value($proto); |
18 | |
19 | my $clone = exists $args{init_arg} ? $args{init_arg} : $self->_copy_ref($self->get_value($proto)); |
20 | |
21 | $self->set_value( $target, $clone ); |
22 | } |
23 | |
24 | sub _copy_ref { |
25 | my ( $self, $value ) = @_; |
26 | |
27 | if ( not ref $value ) { |
28 | return $value; |
29 | } elsif ( ref $value eq 'ARRAY' ) { |
30 | return [@$value]; |
31 | } elsif ( ref $value eq 'HASH' ) { |
32 | return {%$value}; |
33 | } else { |
34 | croak "The Copy trait is for arrays and hashes. Use the Clone trait for objects"; |
35 | } |
36 | } |
37 | |
38 | __PACKAGE__ |
39 | |
40 | __END__ |
41 | |
42 | =pod |
43 | |
44 | =head1 NAME |
45 | |
46 | MooseX::Clone::Meta::Attribute::Trait::Copy - Simple copying of arrays and |
47 | hashes for L<MooseX::Clone> |
48 | |
49 | =head1 SYNOPSIS |
50 | |
51 | has foo => ( |
52 | isa => "ArrayRef", |
53 | traits => [qw(Copy)], |
54 | ); |
55 | |
56 | =head1 DESCRIPTION |
57 | |
58 | Unlike the C<Clone> trait, which does deep copying of almost anything, this |
59 | trait will only do one additional level of copying of arrays and hashes. |
60 | |
61 | This is both simpler and faster when you don't need a real deep copy of the |
62 | entire structure, and probably more correct. |
63 | |
64 | =cut |
65 | |
66 | |