/usr/share/perl5/MooseX/Aliases/Meta/Trait/Attribute.pm is in libmoosex-aliases-perl 0.11-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 | package MooseX::Aliases::Meta::Trait::Attribute;
BEGIN {
$MooseX::Aliases::Meta::Trait::Attribute::AUTHORITY = 'cpan:DOY';
}
{
$MooseX::Aliases::Meta::Trait::Attribute::VERSION = '0.11';
}
use Moose::Role;
use Moose::Util::TypeConstraints;
Moose::Util::meta_attribute_alias 'Aliased';
# ABSTRACT: attribute metaclass trait for L<MooseX::Aliases>
subtype 'MooseX::Aliases::ArrayRef', as 'ArrayRef[Str]';
coerce 'MooseX::Aliases::ArrayRef', from 'Str', via { [$_] };
has alias => (
is => 'ro',
isa => 'MooseX::Aliases::ArrayRef',
auto_deref => 1,
coerce => 1,
predicate => 'has_alias',
);
after install_accessors => sub {
my $self = shift;
my $class_meta = $self->associated_class;
my $orig_name = $self->get_read_method;
my $orig_meth = $self->get_read_method_ref;
for my $alias ($self->alias) {
$class_meta->add_method(
$alias => MooseX::Aliases::_get_method_metaclass($orig_meth)->wrap(
sub { shift->$orig_name(@_) }, # goto $_[0]->can($orig_name) ?
package_name => $class_meta->name,
name => $alias,
aliased_from => $orig_name,
)
);
}
};
around initialize_instance_slot => sub {
my $orig = shift;
my $self = shift;
my ($meta_instance, $instance, $params) = @_;
return $self->$orig(@_)
# don't run if we haven't set any aliases
# don't run if init_arg is explicitly undef
unless $self->has_alias && $self->has_init_arg;
if (my @aliases = grep { exists $params->{$_} } @{ $self->alias }) {
if (exists $params->{ $self->init_arg }) {
push @aliases, $self->init_arg;
}
$self->associated_class->throw_error(
'Conflicting init_args: (' . join(', ', @aliases) . ')'
) if @aliases > 1;
$params->{ $self->init_arg } = delete $params->{ $aliases[0] };
}
$self->$orig(@_);
};
no Moose::Role;
1;
__END__
=pod
=head1 NAME
MooseX::Aliases::Meta::Trait::Attribute - attribute metaclass trait for L<MooseX::Aliases>
=head1 VERSION
version 0.11
=head1 SYNOPSIS
package MyApp::Role;
use Moose::Role;
use MooseX::Aliases;
has this => (
isa => 'Str',
is => 'rw',
alias => 'that',
);
=head1 DESCRIPTION
This trait adds the C<alias> option to attribute creation. It is automatically
applied to all attributes when C<use MooseX::Aliases;> is run.
=head1 AUTHORS
=over 4
=item *
Jesse Luehrs <doy@tozt.net>
=item *
Chris Prather <chris@prather.org>
=item *
Justin Hunter <justin.d.hunter@gmail.com>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Jesse Luehrs.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|