/usr/share/perl5/Aspect/Advice.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 | package Aspect::Advice;
use strict;
use Carp ();
our $VERSION = '1.04';
sub new {
my $class = shift;
my $self = bless {
@_,
installed => 0,
}, $class;
# Validate the advice and pointcut combination
my $error = $self->_validate;
Carp::croak($error) if defined $error;
# Install and save the lexical hook
$self->{hook} = $self->_install;
return $self;
}
sub code {
$_[0]->{code};
}
sub pointcut {
$_[0]->{pointcut};
}
sub lexical {
$_[0]->{lexical};
}
sub installed {
$_[0]->{installed};
}
sub DESTROY {
$_[0]->{hook}->() if $_[0]->{hook};
}
######################################################################
# Installation Internals
sub _install {
my $class = ref $_[0] || $_[0];
die("Method '_install' is not implemented by class '$class'");
}
sub _validate {
my $self = shift;
# The use of more than one highest rule in a pointcut is not supported
if ( $self->pointcut->match_contains('Aspect::Pointcut::Highest') > 1 ) {
return "Multiple highest pointcut use is not yet supported";
}
return;
}
######################################################################
# Optional XS Acceleration
BEGIN {
local $@;
eval <<'END_PERL';
use Class::XSAccessor 1.08 {
replace => 1,
getters => {
'code' => 'code',
'pointcut' => 'pointcut',
'lexical' => 'lexical',
},
};
END_PERL
}
1;
__END__
=pod
=head1 NAME
Aspect::Advice - Change how Perl code is run at a pointcut
=head1 SYNOPSIS
# Trace calls to all functions in all MyAccount classes
use Aspect;
before {
print 'Called: '. $_->sub_name;
} call qw/^MyAccount::/;
# Repeat using the pure object-oriented interface
use Aspect::Advice::Before ();
use Aspect::Pointcut::Call ();
my $advice = Aspect::Advice::Before->new(
pointcut => Aspect::Pointcut::Call->new( qr/^MyAccount::/ ),
code => sub {
print 'called: '. $_->sub_name;
},
);
=head1 DESCRIPTION
An "advice" in AOP lingo is composed of a condition (known as a
L<Aspect::Pointcut|pointcut>) and some code that will run when that
pointcut is true.
This code is run before, after, or around the target pointcut depending on
the particular advice type declaration used.
You do not normally create advice using the constructor. By C<use()>ing
L<Aspect|::Aspect>, you get five advice declaration subroutines imported.
C<before> is used to indicate code that should run prior to the function
being called. See L<Aspect::Advice::Before> for more information.
C<after> is used to indicate code that should run following the function
being called, regardless of whether it returns normally or throws an
exception. See L<Aspect::Advice::After> for more information.
C<around> is used to take deeper control of the call and gives you your
own lexical scope between the caller and callee, with a specific C<proceed>
call required in your code to execute the target function. See
L<Aspect::Advice::Around> for more information.
When the advice code is called, it is provided with an L<Advice::Point>
object which describes the context of the call to the target function, and
allows you to change it.
This parameter is provided both via the topic variable C<$_> (since version
0.90) and additionally as the first parameter to the advice code (which may
be deprecated at some point in the future).
If you are creating C<advice> objects directly via the OO interface, you
should never use this class directly but instead use the class of the
particular type of advice you want to create.
=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
|