/usr/share/perl5/MooseX/Clone.pm is in libmoosex-clone-perl 0.05-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | #!/usr/bin/perl
package MooseX::Clone;
use Moose::Role;
our $VERSION = "0.05";
use Hash::Util::FieldHash 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<Moose> 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<Moose> only provides very barebones cloning support in order
to maximize flexibility.
This role provides a C<clone> method that makes use of the low level cloning
support already in L<Moose> and adds selective deep cloning based on
introspection on top of that. Attributes with the C<Clone> trait will handle
cloning of data within the object, typically delegating to the attribute
value's own C<clone> method.
=head1 TRAITS
=over 4
=item Clone
By default Moose objects are cloned like this:
bless { %$old }, ref $old;
By specifying the L<Clone> trait for certain attributes custom behavior the
value's own C<clone> method will be invoked.
By extending this trait you can create custom cloning for certain attributes.
By creating C<clone> methods for your objects (e.g. by composing
L<MooseX::Compile>) 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<MooseX::Clone::Meta::Attribute::Trait::Clone>
role will handle cloning of that attribute. All other fields are plainly copied
over, just like in L<Class::MOP::Class/clone_object>.
Attributes whose C<init_arg> is in %params and who do the C<Clone> trait will
get that argument passed to the C<clone> method (dereferenced). If the
attribute does not self-clone then the param is used normally by
L<Class::MOP::Class/clone_object>, 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<http://code2.0beta.co.uk/moose/svn/>. Ask on #moose for commit bits.
=head1 AUTHOR
Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
=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
|