/usr/lib/x86_64-linux-gnu/perl5/5.20/MooseX/Role/WithOverloading/Meta/Role/Application.pm is in libmoosex-role-withoverloading-perl 0.15-1+b1.
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 | package MooseX::Role::WithOverloading::Meta::Role::Application;
BEGIN {
$MooseX::Role::WithOverloading::Meta::Role::Application::AUTHORITY = 'cpan:FLORA';
}
# ABSTRACT: Role application role for Roles which support overloading
$MooseX::Role::WithOverloading::Meta::Role::Application::VERSION = '0.15';
use Moose::Role 1.15;
use overload ();
use namespace::autoclean;
requires 'apply_methods';
#pod =method overload_ops
#pod
#pod Returns an arrayref of the names of overloaded operations
#pod
#pod =cut
has overload_ops => (
is => 'ro',
isa => 'ArrayRef[Str]',
builder => '_build_overload_ops',
);
sub _build_overload_ops {
return [map { split /\s+/ } values %overload::ops];
}
#pod =method apply_methods ($role, $other)
#pod
#pod Wrapped with an after modifier which calls the C<< ->apply_overloading >>
#pod method.
#pod
#pod =cut
after apply_methods => sub {
my ($self, $role, $other) = @_;
$self->apply_overloading($role, $other);
};
#pod =method apply_overloading ($role, $other)
#pod
#pod Does the heavy lifting of applying overload operations to
#pod a class or role which the role is applied to.
#pod
#pod =cut
sub apply_overloading {
my ($self, $role, $other) = @_;
return unless overload::Overloaded($role->name);
# &(( indicates that overloading is turned on with Perl 5.18+. &() does
# this in earlier perls. $() stores the fallback value if one was set.
for my $sym (qw{ &(( &() $() }) {
# Simply checking ->has_package_symbol doesn't work. With 5.18+, a
# package may have &() and $() symbols but they may be undef.
my $ref = $role->get_package_symbol($sym);
$other->add_package_symbol($sym => $ref)
if defined $ref;
}
# register with magic by touching (changes to SVf_AMAGIC removed %OVERLOAD in 5.17.0)
$other->get_or_add_package_symbol('%OVERLOAD')->{dummy}++ if $^V < 5.017000;
for my $op (@{ $self->overload_ops }) {
my $code_sym = '&(' . $op;
next if overload::Method($other->name, $op);
next unless $role->has_package_symbol($code_sym);
my $meth = $role->get_package_symbol($code_sym);
next unless $meth;
# when using "use overload $op => sub { };" this is the actual method
# to be called on overloading. otherwise it's \&overload::nil. see
# below.
$other->add_package_symbol($code_sym => $meth);
# when using "use overload $op => 'method_name';" overload::nil is
# installed into the code slot of the glob and the actual method called
# is determined by the scalar slot of the same glob.
if ($meth == \&overload::nil) {
my $scalar_sym = qq{\$($op};
$other->add_package_symbol(
$scalar_sym => ${ $role->get_package_symbol($scalar_sym) },
);
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
MooseX::Role::WithOverloading::Meta::Role::Application - Role application role for Roles which support overloading
=head1 VERSION
version 0.15
=head1 METHODS
=head2 overload_ops
Returns an arrayref of the names of overloaded operations
=head2 apply_methods ($role, $other)
Wrapped with an after modifier which calls the C<< ->apply_overloading >>
method.
=head2 apply_overloading ($role, $other)
Does the heavy lifting of applying overload operations to
a class or role which the role is applied to.
=head1 AUTHORS
=over 4
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Tomas Doran <bobtfish@bobtfish.net>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2009 by Florian Ragwitz.
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
|