MooseX-Clone-0.05/000755 000765 000024 00000000000 11323406062 015371 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/Changes000644 000765 000024 00000000745 11323405602 016671 0ustar00nothingmuchstaff000000 000000 0.05 - Fix cloning for attrs when init_arg is passed under Clone trait - auto_deref related fixes (Evan Carroll) 0.04 - update code to call get_all_attributes instead of compute_all_applicable_attributes - more tests - add the StorableClone trait 0.03 - Add the Copy trait (simple 1 level cloning of hashes and array refs) - namespace::clean all over 0.02 - Add deep cloning support using Data::Visitor - Add the NoClone trait 0.01 - Initial release MooseX-Clone-0.05/lib/000755 000765 000024 00000000000 11323406062 016137 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/Makefile.PL000644 000765 000024 00000000634 11173130542 017346 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl -w use strict; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'MooseX::Clone', VERSION_FROM => 'lib/MooseX/Clone.pm', INSTALLDIRS => 'site', SIGN => 1, PL_FILES => { }, PREREQ_PM => { 'Test::use::ok' => 0, 'Hash::Util::FieldHash::Compat' => 0, 'Moose' => "0.74", 'Data::Visitor' => '0.24', 'namespace::clean' => '0.08', }, ); MooseX-Clone-0.05/MANIFEST000644 000765 000024 00000001101 11323406062 016513 0ustar00nothingmuchstaff000000 000000 Changes lib/MooseX/Clone.pm lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Base.pm lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm lib/MooseX/Clone/Meta/Attribute/Trait/NoClone.pm lib/MooseX/Clone/Meta/Attribute/Trait/StorableClone.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP t/01_basic.t t/02_auto_deref.t META.yml Module meta-data (added by MakeMaker) SIGNATURE Public-key signature (added by MakeMaker) MooseX-Clone-0.05/MANIFEST.SKIP000644 000765 000024 00000001125 11173130617 017271 0ustar00nothingmuchstaff000000 000000 # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \b_darcs\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ # Avoid Devel::Cover files. \bcover_db\b ### DEFAULT MANIFEST.SKIP ENDS HERE #### \.DS_Store$ \.sw.$ (\w+-)*(\w+)-\d\.\d+(?:\.tar\.gz)?$ \.t\.log$ \.prove$ # XS shit \.(?:bs|c|o)$ MooseX-Clone-0.05/META.yml000644 000765 000024 00000001164 11323406062 016644 0ustar00nothingmuchstaff000000 000000 --- #YAML:1.0 name: MooseX-Clone version: 0.05 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Data::Visitor: 0.24 Hash::Util::FieldHash::Compat: 0 Moose: 0.74 namespace::clean: 0.08 Test::use::ok: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 MooseX-Clone-0.05/SIGNATURE000644 000765 000024 00000003370 11323406062 016660 0ustar00nothingmuchstaff000000 000000 This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.61. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 233d63545de8f2c778f145e0bfe27fe1d76fdd68 Changes SHA1 e9684f5d7fff2575dd1f8a45d6db3965a29b7e76 MANIFEST SHA1 190e9058eb9c6446a1a3f3ddf15b082f1ecde152 MANIFEST.SKIP SHA1 ef1412820bfe9d3c8ae4d42744b99d25e816cf14 META.yml SHA1 c2d2e660d73bc6dc4f78da56245cb9fb25647193 Makefile.PL SHA1 b7cef6bdf11a249feaacfc20855bb64b04e1fda9 lib/MooseX/Clone.pm SHA1 18bc51be816c7d0e2259b4516e5230945e12ec74 lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm SHA1 e91991fef9bc32c3ec9062f4584b27f248534cee lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Base.pm SHA1 2032a4a9ade9579d1649fd1568e61157ba15be04 lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm SHA1 4a2a6440466154abd02b09b72e7759d3d724ab84 lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm SHA1 8d4bd7f05e74d25115c1558f6ef5f97ffe8ce0ab lib/MooseX/Clone/Meta/Attribute/Trait/NoClone.pm SHA1 d4a8de859dccee4a2f90f02e3af857562f765133 lib/MooseX/Clone/Meta/Attribute/Trait/StorableClone.pm SHA1 96c97f40ff26f572bccbb05bd7b2ddde9b908214 t/01_basic.t SHA1 f7deeef5e8d2c41e6090644e59ef69f9afad5a72 t/02_auto_deref.t -----BEGIN PGP SIGNATURE----- Version: GnuPG/MacGPG2 v2.0.12 (Darwin) iEYEARECAAYFAktODDIACgkQVCwRwOvSdBgC8ACdHAWMj7Z/Ju8KXmo1svDjkiY3 ZY4AnRwXhW+yXSWPHzzyY2FNO+4/EcME =0S8Q -----END PGP SIGNATURE----- MooseX-Clone-0.05/t/000755 000765 000024 00000000000 11323406062 015634 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/t/01_basic.t000644 000765 000024 00000006044 11175323707 017417 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; use Scalar::Util qw(refaddr); { package Bar; use Moose; with qw(MooseX::Clone); has foo => ( traits => [qw(Clone)], isa => "Foo|HashRef", is => "rw", default => sub { Foo->new }, ); has same => ( isa => "Foo", is => "rw", default => sub { Foo->new }, ); has floo => ( traits => [qw(NoClone)], isa => "Int", is => "rw", ); has flar => ( traits => [qw(Copy)], isa => "HashRef", is => "rw", ); has blorg => ( traits => [qw(StorableClone)], is => "rw", ); package Foo; use Moose; has copy_number => ( isa => "Int", is => "ro", default => 0, ); has some_attr => ( is => "rw", default => "def" ); sub clone { my ( $self, %params ) = @_; $self->meta->clone_object( $self, %params, copy_number => $self->copy_number + 1 ); } } my $bar = Bar->new( floo => 3 ); isa_ok( $bar, "Bar" ); isa_ok( $bar->foo, "Foo" ); isa_ok( $bar->same, "Foo" ); is( $bar->floo, 3, "explicit init_arg" ); is( $bar->foo->copy_number, 0, "first copy" ); is( $bar->same->copy_number, 0, "first copy" ); is( $bar->foo->some_attr, 'def', "default value for other attr" ); my $copy = $bar->clone; isnt( refaddr($bar), refaddr($copy), "copy" ); is( $copy->floo, undef, "NoClone" ); is( $copy->foo->copy_number, 1, "copy number incremented" ); is( $copy->same->copy_number, 0, "not incremented for uncloned attr" ); is( $copy->foo->some_attr, 'def', "default value for other attr" ); isnt( refaddr($bar->foo), refaddr($copy->foo), "copy" ); is( refaddr($bar->same), refaddr($copy->same), "copy" ); is( $copy->clone( foo => { some_attr => "laaa" } )->foo->some_attr, "laaa", "Value carried over to recursive call to clone" ); { my $hash = { foo => Foo->new }; my $hash_copy = Bar->new( foo => $hash )->clone->foo; isnt( refaddr($hash), refaddr($hash_copy), "hash copied" ); is_deeply( [ sort keys %$hash ], [ sort keys %$hash_copy ], "hash keys exist in clone" ); isa_ok($hash_copy->{foo}, "Foo"); isnt( refaddr($hash->{foo}), refaddr($hash_copy->{foo}), "foo inside hash cloned too" ); is( $hash_copy->{foo}->copy_number, 1, "copy number" ); } { my $hash = { foo => Foo->new, bar => [] }; my $hash_copy = Bar->new( flar => $hash )->clone->flar; isnt( refaddr($hash), refaddr($hash_copy), "hash copied" ); is_deeply( [ sort keys %$hash ], [ sort keys %$hash_copy ], "hash keys exist in clone" ); isa_ok($hash_copy->{foo}, "Foo"); is( refaddr($hash->{foo}), refaddr($hash_copy->{foo}), "foo inside hash not cloned" ); is( refaddr($hash->{bar}), refaddr($hash_copy->{bar}), "array inside hash not cloned" ); } { my $foo = Foo->new; my $foo_copy = Bar->new( blorg => $foo )->clone->blorg; isnt( refaddr($foo), refaddr($foo_copy), "foo copied" ); is( $foo_copy->copy_number, $foo->copy_number, "but not using ->clone"); } MooseX-Clone-0.05/t/02_auto_deref.t000644 000765 000024 00000002313 11316713775 020454 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 5; { package Foo; use Moose; with 'MooseX::Clone'; has 'arr_ref' => ( isa => 'ArrayRef', is => 'ro', default => sub { [qw/foo bar baz/] }, traits => [qw/Clone/] ); package Bar; use Moose; with 'MooseX::Clone'; has 'arr_ref' => ( isa => 'ArrayRef', is => 'ro', auto_deref => 1, default => sub { [qw/foo bar baz/] }, traits => [qw/Clone/] ); package Baz; use Moose; with 'MooseX::Clone'; has 'arr_ref' => ( isa => 'ArrayRef', is => 'ro', auto_deref => 1, default => sub { [qw/foo bar/] }, traits => [qw/Clone/] ); } eval { Foo->new->clone }; ok( !$@, 'cloning simple obj with a ArrayRef' ); my $clone = eval { Bar->new->clone }; ok( !$@, 'cloning simple obj with a ArrayRef (3 elements) and auto_deref' ); ok( $clone, "got a clone" ); is_deeply( eval { [ $clone->arr_ref ] }, [qw(foo bar baz)], "value cloned properly" ); eval { Bar->new->clone }; ok( !$@, 'cloning simple obj with a ArrayRef (2 elements) and auto_deref' ); MooseX-Clone-0.05/lib/MooseX/000755 000765 000024 00000000000 11323406062 017351 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/lib/MooseX/Clone/000755 000765 000024 00000000000 11323406062 020411 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/lib/MooseX/Clone.pm000644 000765 000024 00000010303 11323404516 020746 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl package MooseX::Clone; use Moose::Role; our $VERSION = "0.05"; use Hash::Util::FieldHash::Compat qw(idhash); use MooseX::Clone::Meta::Attribute::Trait::Clone; use MooseX::Clone::Meta::Attribute::Trait::StorableClone; use MooseX::Clone::Meta::Attribute::Trait::NoClone; use MooseX::Clone::Meta::Attribute::Trait::Copy; use namespace::clean -except => 'meta'; sub clone { my ( $self, %params ) = @_; my $meta = $self->meta; my @cloning; idhash my %clone_args; attr: foreach my $attr ($meta->get_all_attributes()) { # collect all attrs that can be cloned. # if they have args in %params then those are passed to the recursive cloning op if ( $attr->does("MooseX::Clone::Meta::Attribute::Trait::Clone::Base") ) { push @cloning, $attr; if ( defined( my $init_arg = $attr->init_arg ) ) { if ( exists $params{$init_arg} ) { $clone_args{$attr} = delete $params{$init_arg}; } } } } my $clone = $meta->clone_object($self, %params); foreach my $attr ( @cloning ) { $clone->clone_attribute( proto => $self, attr => $attr, ( exists $clone_args{$attr} ? ( init_arg => $clone_args{$attr} ) : () ), ); } return $clone; } sub clone_attribute { my ( $self, %args ) = @_; my ( $proto, $attr ) = @args{qw/proto attr/}; $attr->clone_value( $self, $proto, %args ); } __PACKAGE__ __END__ =pod =head1 NAME MooseX::Clone - Fine grained cloning support for L objects. =head1 SYNOPSIS package Bar; use Moose; with qw(MooseX::Clone); has foo => ( isa => "Foo", traits => [qw(Clone)], # this attribute will be recursively cloned ); package Foo; use Moose; # this API is used/provided by MooseX::Clone sub clone { my ( $self, %params ) = @_; # ... } # used like this: my $bar = Bar->new( foo => Foo->new ); my $copy = $bar->clone( foo => [ qw(Args for Foo::clone) ] ); =head1 DESCRIPTION Out of the box L only provides very barebones cloning support in order to maximize flexibility. This role provides a C method that makes use of the low level cloning support already in L and adds selective deep cloning based on introspection on top of that. Attributes with the C trait will handle cloning of data within the object, typically delegating to the attribute value's own C method. =head1 TRAITS =over 4 =item Clone By default Moose objects are cloned like this: bless { %$old }, ref $old; By specifying the L trait for certain attributes custom behavior the value's own C method will be invoked. By extending this trait you can create custom cloning for certain attributes. By creating C methods for your objects (e.g. by composing L) you can make them interact with this trait. =item NoClone Specifies attributes that should be skipped entirely while cloning. =back =head1 METHODS =over 4 =item clone %params Returns a clone of the object. All attributes which do the L role will handle cloning of that attribute. All other fields are plainly copied over, just like in L. Attributes whose C is in %params and who do the C trait will get that argument passed to the C method (dereferenced). If the attribute does not self-clone then the param is used normally by L, that is it will simply shadow the previous value, and does not have to be an array or hash reference. =back =head1 TODO Refactor to work in term of a metaclass trait so that C<< meta->clone_object >> will still do the right thing. =head1 THANKS clkao made the food required to write this module =head1 VERSION CONTROL L. Ask on #moose for commit bits. =head1 AUTHOR Yuval Kogman Enothingmuch@woobling.orgE =head1 COPYRIGHT Copyright (c) 2008 Yuval Kogman. All rights reserved This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut MooseX-Clone-0.05/lib/MooseX/Clone/Meta/000755 000765 000024 00000000000 11323406062 021277 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/000755 000765 000024 00000000000 11323406062 023242 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/000755 000765 000024 00000000000 11323406062 024325 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/000755 000765 000024 00000000000 11323406062 025365 5ustar00nothingmuchstaff000000 000000 MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm000644 000765 000024 00000012155 11317407720 025734 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl package MooseX::Clone::Meta::Attribute::Trait::Clone; 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::Clone::register_implementation { __PACKAGE__ } has clone_only_objects => ( isa => "Bool", is => "rw", default => 0, ); has clone_visitor => ( isa => "Data::Visitor", is => "rw", lazy_build => 1, ); has clone_visitor_config => ( isa => "HashRef", is => "ro", default => sub { { } }, ); sub _build_clone_visitor { my $self = shift; require Data::Visitor::Callback; Data::Visitor::Callback->new( object => sub { $self->clone_object_value($_[1]) }, tied_as_objects => 1, %{ $self->clone_visitor_config }, ); } sub clone_value { my ( $self, $target, $proto, @args ) = @_; if ( $self->has_value($proto) ) { my $clone = $self->clone_value_data( scalar($self->get_value($proto)), @args ); $self->set_value( $target, $clone ); } else { my %args = @args; if ( exists $args{init_arg} ) { $self->set_value( $target, $args{init_arg} ); } } } sub clone_value_data { my ( $self, $value, @args ) = @_; if ( blessed($value) ) { return $self->clone_object_value($value, @args); } else { my %args = @args; if ( exists $args{init_arg} ) { return $args{init_arg}; } else { unless ( $self->clone_only_objects ) { return $self->clone_any_value($value, @args); } else { return $value; } } } } sub clone_object_value { my ( $self, $value, %args ) = @_; if ( $value->can("clone") ) { my @clone_args; if ( exists $args{init_arg} ) { my $init_arg = $args{init_arg}; if ( ref $init_arg ) { if ( ref $init_arg eq 'HASH' ) { @clone_args = %$init_arg } elsif ( ref $init_arg eq 'ARRAY' ) { @clone_args = @$init_arg } else { croak "Arguments to a sub clone should be given in a hash or array reference"; } } else { croak "Arguments to a sub clone should be given in a hash or array reference"; } } return $value->clone(@clone_args); } else { croak "Cannot recursively clone a retarded object $value (" . overload::StrVal($value) . ") in " . $args{attr}->name . ". Try something better."; } } sub clone_any_value { my ( $self, $value, %args ) = @_; $self->clone_visitor->visit($value); } __PACKAGE__ __END__ =pod =encoding utf8 =head1 NAME MooseX::Clone::Meta::Attribute::Trait::Clone - The L trait for deeply cloning attributes. =head1 SYNOPSIS # see MooseX::Clone has foo => ( traits => [qw(Clone)], isa => "Something", ); $object->clone; # will recursively call $object->foo->clone and set the value properly =head1 DESCRIPTION This meta attribute trait provides a C method, in the spirit of C and C. This allows clone methods such as the one in L to make use of this per-attribute cloning behavior. =head1 DERIVATION Deriving this role for your own cloning purposes is encouraged. This will allow your fine grained cloning semantics to interact with L in the Right™ way. =head1 ATTRIBUTES =over 4 =item clone_only_objects Whether or not L should be used to clone arbitrary structures. Objects found in these structures will be cloned using L. If true then non object values will be copied over in shallow cloning semantics (shared reference). Defaults to false (all reference will be cloned). =item clone_visitor_config A hash ref used to construct C. Defaults to the empty ref. This can be used to alter the cloning behavior for non object values. =item clone_visitor The L object that will be used to clone. It has an C handler that delegates to C and sets C to true in order to deeply clone tied structures while retaining magic. Only used if C is false and the value of the attribute is not an object. =back =head1 METHODS =over 4 =item clone_value $target, $proto, %args Clones the value the attribute encapsulates from C<$proto> into C<$target>. =item clone_value_data $value, %args Does the actual cloning of the value data by delegating to a C method on the object if any. If the object does not support a C method an error is thrown. If the value is not an object then it will not be cloned. In the future support for deep cloning of simple refs will be added too. =item clone_object_value $object, %args This is the actual workhorse of C. =item clone_any_value $value, %args Uses C to clone all non object values. Called from C if the value is not an object and C is false. =back =cut MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm000644 000765 000024 00000002646 11170136337 025612 0ustar00nothingmuchstaff000000 000000 #!/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 =head1 SYNOPSIS has foo => ( isa => "ArrayRef", traits => [qw(Copy)], ); =head1 DESCRIPTION Unlike the C 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 MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/NoClone.pm000644 000765 000024 00000002612 11132274611 026222 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl package MooseX::Clone::Meta::Attribute::Trait::NoClone; use Moose::Role; use namespace::clean -except => [qw(meta)]; with qw(MooseX::Clone::Meta::Attribute::Trait::Clone::Base); sub Moose::Meta::Attribute::Custom::Trait::NoClone::register_implementation { __PACKAGE__ } sub clone_value { my ( $self, $target, $proto, %args ) = @_; # FIXME default cloning behavior works like this #if ( exists $args{init_arg} ) { # $self->set_value($args{init_arg}); #} else { # but i think this is more correct $self->clear_value($target); $self->initialize_instance_slot( $self->meta->get_meta_instance, $target, { exists $args{init_arg} ? ( $self->init_arg => $args{init_arg} ) : () }, ); } __PACKAGE__ __END__ =pod =head1 NAME MooseX::Clone::Meta::Attribute::Trait::NoClone - A trait for attrs that should not be copied while cloning. =head1 SYNOPSIS with qw(MooseX::Clone); has _some_special_thingy => ( traits => [qw(NoClone)], ); =head1 DESCRIPTION Sometimes certain values should not be carried over when cloning an object. This attribute trait implements just that. =head1 METHODS =over 4 =item clone_value If the C param is set (that means an explicit value was given to C) sets the attribute to that value. Otherwise calls C and C. =back =cut MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/StorableClone.pm000644 000765 000024 00000005753 11170136337 027436 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl package MooseX::Clone::Meta::Attribute::Trait::StrableClone; use Moose::Role; use Carp qw(croak); use namespace::clean -except => 'meta'; with qw(MooseX::Clone::Meta::Attribute::Trait::Clone::Std); sub Moose::Meta::Attribute::Custom::Trait::StorableClone::register_implementation { __PACKAGE__ } sub clone_value_data { my ( $self, $value, @args ) = @_; if ( ref($value) ) { require Storable; return Storable::dclone($value); } else { return $value; } } __PACKAGE__ __END__ =pod =encoding utf8 =head1 NAME MooseX::Clone::Meta::Attribute::Trait::StorableClone - The L trait for deeply cloning attributes using L. =head1 SYNOPSIS # see MooseX::Clone has foo => ( traits => [qw(StorableClone)], isa => "Something", ); my $clone = $object->clone; # $clone->foo will equal Storable::dclone($object->foo) =head1 DESCRIPTION This meta attribute trait provides a C method, in the spirit of C and C. This allows clone methods such as the one in L to make use of this per-attribute cloning behavior. =head1 DERIVATION Deriving this role for your own cloning purposes is encouraged. This will allow your fine grained cloning semantics to interact with L in the Right™ way. =head1 ATTRIBUTES =over 4 =item clone_only_objects Whether or not L should be used to clone arbitrary structures. Objects found in these structures will be cloned using L. If true then non object values will be copied over in shallow cloning semantics (shared reference). Defaults to false (all reference will be cloned). =item clone_visitor_config A hash ref used to construct C. Defaults to the empty ref. This can be used to alter the cloning behavior for non object values. =item clone_visitor The L object that will be used to clone. It has an C handler that delegates to C and sets C to true in order to deeply clone tied structures while retaining magic. Only used if C is false and the value of the attribute is not an object. =back =head1 METHODS =over 4 =item clone_value $target, $proto, %args Clones the value the attribute encapsulates from C<$proto> into C<$target>. =item clone_value_data $value, %args Does the actual cloning of the value data by delegating to a C method on the object if any. If the object does not support a C method an error is thrown. If the value is not an object then it will not be cloned. In the future support for deep cloning of simple refs will be added too. =item clone_object_value $object, %args This is the actual workhorse of C. =item clone_any_value $value, %args Uses C to clone all non object values. Called from C if the value is not an object and C is false. =back =cut MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Base.pm000644 000765 000024 00000000272 11170135033 026573 0ustar00nothingmuchstaff000000 000000 #!/usr/bin/perl package MooseX::Clone::Meta::Attribute::Trait::Clone::Base; use Moose::Role; use namespace::clean -except => [qw(meta)]; requires "clone_value"; __PACKAGE__ __END__ MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm000644 000765 000024 00000001061 11316714016 026456 0ustar00nothingmuchstaff000000 000000 package MooseX::Clone::Meta::Attribute::Trait::Clone::Std; use Moose::Role; use namespace::clean -except => 'meta'; with qw(MooseX::Clone::Meta::Attribute::Trait::Clone::Base); requires qw(clone_value_data); sub clone_value { my ( $self, $target, $proto, %args ) = @_; if ( exists $args{init_arg} ) { $self->set_value( $target, $args{init_arg} ); } else { return unless $self->has_value($proto); my $clone = $self->clone_value_data( scalar($self->get_value($proto)), %args ); $self->set_value( $target, $clone ); } } __PACKAGE__ __END__