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