/usr/share/perl5/Lmo/Role.pm is in percona-toolkit 3.0.6+dfsg-2.
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 | # This program is copyright 2013 Percona Ireland Ltd.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307 USA.
# ###########################################################################
# Lmo::Role package
# ###########################################################################
package Lmo::Role;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Lmo ();
use base qw(Role::Tiny);
use Lmo::Utils qw(_install_coderef _unimport_coderefs _stash_for);
BEGIN { *INFO = \%Role::Tiny::INFO }
our %INFO;
sub _install_tracked {
my ($target, $name, $code) = @_;
$INFO{$target}{exports}{$name} = $code;
_install_coderef "${target}::${name}" => $code;
}
sub import {
my $target = caller;
my ($me) = @_;
# Set warnings and strict for the caller.
warnings->import(qw(FATAL all));
strict->import();
=begin
if ($Moo::MAKERS{$target} and $Moo::MAKERS{$target}{is_class}) {
die "Cannot import Moo::Role into a Moo class";
}
=cut
return if $INFO{$target}; # already exported into this package
$INFO{$target} = { is_role => 1 };
# get symbol table reference_unimport_coderefs
my $stash = _stash_for $target;
_install_tracked $target => has => \*Lmo::has;
# install before/after/around subs
foreach my $type (qw(before after around)) {
_install_tracked $target => $type => sub {
require Class::Method::Modifiers;
push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
};
}
_install_tracked $target => requires => sub {
push @{$INFO{$target}{requires}||=[]}, @_;
};
_install_tracked $target => with => \*Lmo::with;
# grab all *non-constant* (stash slot is not a scalarref) subs present
# in the symbol table and store their refaddrs (no need to forcibly
# inflate constant subs into real subs) - also add '' to here (this
# is used later) with a map to the coderefs in case of copying or re-use
my @not_methods = ('', map { *$_{CODE}||() } grep !ref($_), values %$stash);
@{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
# a role does itself
$Role::Tiny::APPLIED_TO{$target} = { $target => undef };
}
sub unimport {
my $target = caller;
_unimport_coderefs($target, keys %{$INFO{$target}{exports}});
}
1;
# ###########################################################################
# End Lmo::Role package
# ###########################################################################
|