local-lib5/lib/perl5/MooseX/Clone/Meta/Attribute/Trait/Copy.pm

   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