/usr/share/perl5/Aspect/Pointcut/Call.pm is in libaspect-perl 1.04-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 180 | package Aspect::Pointcut::Call;
use strict;
use Carp ();
use Params::Util ();
use Aspect::Pointcut ();
our $VERSION = '1.04';
our @ISA = 'Aspect::Pointcut';
use constant ORIGINAL => 0;
use constant COMPILE_CODE => 1;
use constant RUNTIME_CODE => 2;
use constant COMPILE_EVAL => 3;
use constant RUNTIME_EVAL => 4;
######################################################################
# Constructor Methods
# The constructor stores three values.
# $self->[0] is the original specification provided to the constructor
# $self->[1] is a function form of the condition that has a sub name passed
# in and returns true if matching or false if not.
# $self->[2] is a function form of the condition that has the sub name set as
# the topic variable.
# $self->[3] is a function form of the condition that has the join point object
# set as the topic variable.
# $self->[4] is either a string Perl fragment that can be eval'ed with $_ set
# as the sub name, or a function that can be called with $_ set as
# the sub name.
# $self->[5] is either a string Perl fragment that can be eval'ed with $_ set
# as the join point variable, or a function that can be called with
# $_ set as the join point variable.
# All of 1-5 return true of the condition matches, or false if not.
sub new {
my $class = shift;
my $spec = shift;
if ( Params::Util::_STRING($spec) ) {
my $string = '"' . quotemeta($spec) . '"';
return bless [
$spec,
eval "sub () { \$_[0] eq $string }",
eval "sub () { \$_ eq $string }",
eval "sub () { \$Aspect::POINT->{sub_name} eq $string }",
"\$_ eq $string",
"\$Aspect::POINT->{sub_name} eq $string",
], $class;
}
if ( Params::Util::_CODELIKE($spec) ) {
return bless [
$spec,
$spec,
sub { $spec->($_) },
sub { $spec->($Aspect::POINT->{sub_name}) },
sub { $spec->($_) },
sub { $spec->($Aspect::POINT->{sub_name}) },
], $class;
}
if ( Params::Util::_REGEX($spec) ) {
# Special case serialisation of regexs
# In Perl 5.13.6 the format of a serialised regex changed
# incompatibly. Worse, the optimisation trick that worked
# before no longer works after, as there are now modifiers
# that are ONLY value inside and can't be moved to the end.
# So we first serialise to a form that will be valid code
# under the new system, and then do the replace that will
# only match (and only be valid) under the old system.
my $regex = "/$spec/";
$regex =~ s|^/\(\?([xism]*)-[xism]*:(.*)\)/\z|/$2/$1|s;
return bless [
$spec,
eval "sub () { \$_[0] =~ $regex }",
eval "sub () { $regex }",
eval "sub () { \$Aspect::POINT->{sub_name} =~ $regex }",
$regex,
"\$Aspect::POINT->{sub_name} =~ $regex",
], $class;
}
Carp::croak("Invalid function call specification");
}
######################################################################
# Weaving Methods
sub match_runtime {
return 0;
}
# Call pointcuts are the primary thing used at weave time
sub curry_weave {
return $_[0];
}
# Call pointcuts curry away to null, because they are the basis
# for which methods to hook in the first place. Any method called
# at run-time has already been checked.
sub curry_runtime {
return;
}
# Compiled string form of the pointcut
sub compile_weave {
$_[0]->[4];
}
# Compiled string form of the pointcut
sub compile_runtime {
$_[0]->[5];
}
######################################################################
# Optional XS Acceleration
BEGIN {
local $@;
eval <<'END_PERL';
use Class::XSAccessor::Array 1.08 {
replace => 1,
getters => {
'compile_weave' => 4,
'compile_runtime' => 5,
},
};
END_PERL
}
1;
__END__
=pod
=head1 NAME
Aspect::Pointcut::Call - Call pointcut
=head1 SYNOPSIS
use Aspect;
# High-level creation
my $pointcut1 = call 'one';
# Manual creation
my $pointcut2 = Aspect::Pointcut::Call->new('one');
=head1 DESCRIPTION
None yet.
=head1 AUTHORS
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
Marcel GrE<uuml>nauer E<lt>marcel@cpan.orgE<gt>
Ran Eilam E<lt>eilara@cpan.orgE<gt>
=head1 COPYRIGHT
Copyright 2001 by Marcel GrE<uuml>nauer
Some parts copyright 2009 - 2013 Adam Kennedy.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
|