| File | /usr/local/lib/perl5/5.10.1/attributes.pm |
| Statements Executed | 18 |
| Statement Execution Time | 454µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 22µs | 28µs | attributes::import |
| 1 | 1 | 1 | 19µs | 22µs | attributes::BEGIN@9 |
| 1 | 1 | 1 | 9µs | 15µs | attributes::BEGIN@29 |
| 1 | 1 | 2 | 6µs | 6µs | attributes::bootstrap (xsub) |
| 1 | 1 | 2 | 1µs | 1µs | attributes::_modify_attrs (xsub) |
| 1 | 1 | 2 | 800ns | 800ns | attributes::reftype (xsub) |
| 0 | 0 | 0 | 0s | 0s | attributes::carp |
| 0 | 0 | 0 | 0s | 0s | attributes::croak |
| 0 | 0 | 0 | 0s | 0s | attributes::get |
| 0 | 0 | 0 | 0s | 0s | attributes::require_version |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package attributes; | ||||
| 2 | |||||
| 3 | 1 | 300ns | our $VERSION = 0.09; | ||
| 4 | |||||
| 5 | 1 | 1µs | @EXPORT_OK = qw(get reftype); | ||
| 6 | 1 | 100ns | @EXPORT = (); | ||
| 7 | 1 | 2µs | %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); | ||
| 8 | |||||
| 9 | 3 | 67µs | 2 | 25µs | # spent 22µs (19+3) within attributes::BEGIN@9 which was called
# once (19µs+3µs) by DynaLoader::BEGIN@97 at line 9 # spent 22µs making 1 call to attributes::BEGIN@9
# spent 3µs making 1 call to strict::import |
| 10 | |||||
| 11 | sub croak { | ||||
| 12 | require Carp; | ||||
| 13 | goto &Carp::croak; | ||||
| 14 | } | ||||
| 15 | |||||
| 16 | sub carp { | ||||
| 17 | require Carp; | ||||
| 18 | goto &Carp::carp; | ||||
| 19 | } | ||||
| 20 | |||||
| 21 | ## forward declaration(s) rather than wrapping the bootstrap call in BEGIN{} | ||||
| 22 | #sub reftype ($) ; | ||||
| 23 | #sub _fetch_attrs ($) ; | ||||
| 24 | #sub _guess_stash ($) ; | ||||
| 25 | #sub _modify_attrs ; | ||||
| 26 | # | ||||
| 27 | # The extra trips through newATTRSUB in the interpreter wipe out any savings | ||||
| 28 | # from avoiding the BEGIN block. Just do the bootstrap now. | ||||
| 29 | 1 | 347µs | 2 | 22µs | # spent 15µs (9+6) within attributes::BEGIN@29 which was called
# once (9µs+6µs) by DynaLoader::BEGIN@97 at line 29 # spent 15µs making 1 call to attributes::BEGIN@29
# spent 6µs making 1 call to attributes::bootstrap |
| 30 | |||||
| 31 | # spent 28µs (22+6) within attributes::import which was called
# once (22µs+6µs) by DynaLoader::BEGIN@97 at line 97 of XSLoader.pm | ||||
| 32 | 1 | 900ns | @_ > 2 && ref $_[2] or do { | ||
| 33 | require Exporter; | ||||
| 34 | goto &Exporter::import; | ||||
| 35 | }; | ||||
| 36 | 1 | 1µs | my (undef,$home_stash,$svref,@attrs) = @_; | ||
| 37 | |||||
| 38 | 1 | 9µs | 1 | 800ns | my $svtype = uc reftype($svref); # spent 800ns making 1 call to attributes::reftype |
| 39 | 1 | 0s | my $pkgmeth; | ||
| 40 | 1 | 9µs | 1 | 4µs | $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 4µs making 1 call to UNIVERSAL::can |
| 41 | if defined $home_stash && $home_stash ne ''; | ||||
| 42 | 1 | 100ns | my @badattrs; | ||
| 43 | 1 | 400ns | if ($pkgmeth) { | ||
| 44 | my @pkgattrs = _modify_attrs($svref, @attrs); | ||||
| 45 | @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs); | ||||
| 46 | if (!@badattrs && @pkgattrs) { | ||||
| 47 | require warnings; | ||||
| 48 | return unless warnings::enabled('reserved'); | ||||
| 49 | @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; | ||||
| 50 | if (@pkgattrs) { | ||||
| 51 | for my $attr (@pkgattrs) { | ||||
| 52 | $attr =~ s/\(.+\z//s; | ||||
| 53 | } | ||||
| 54 | my $s = ((@pkgattrs == 1) ? '' : 's'); | ||||
| 55 | carp "$svtype package attribute$s " . | ||||
| 56 | "may clash with future reserved word$s: " . | ||||
| 57 | join(' : ' , @pkgattrs); | ||||
| 58 | } | ||||
| 59 | } | ||||
| 60 | } | ||||
| 61 | else { | ||||
| 62 | 1 | 5µs | 1 | 1µs | @badattrs = _modify_attrs($svref, @attrs); # spent 1µs making 1 call to attributes::_modify_attrs |
| 63 | } | ||||
| 64 | 1 | 4µs | if (@badattrs) { | ||
| 65 | croak "Invalid $svtype attribute" . | ||||
| 66 | (( @badattrs == 1 ) ? '' : 's') . | ||||
| 67 | ": " . | ||||
| 68 | join(' : ', @badattrs); | ||||
| 69 | } | ||||
| 70 | } | ||||
| 71 | |||||
| 72 | sub get ($) { | ||||
| 73 | @_ == 1 && ref $_[0] or | ||||
| 74 | croak 'Usage: '.__PACKAGE__.'::get $ref'; | ||||
| 75 | my $svref = shift; | ||||
| 76 | my $svtype = uc reftype $svref; | ||||
| 77 | my $stash = _guess_stash $svref; | ||||
| 78 | $stash = caller unless defined $stash; | ||||
| 79 | my $pkgmeth; | ||||
| 80 | $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") | ||||
| 81 | if defined $stash && $stash ne ''; | ||||
| 82 | return $pkgmeth ? | ||||
| 83 | (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : | ||||
| 84 | (_fetch_attrs($svref)) | ||||
| 85 | ; | ||||
| 86 | } | ||||
| 87 | |||||
| 88 | sub require_version { goto &UNIVERSAL::VERSION } | ||||
| 89 | |||||
| 90 | 1 | 7µs | 1; | ||
| 91 | __END__ | ||||
| 92 | #The POD goes here | ||||
| 93 | |||||
| 94 | =head1 NAME | ||||
| 95 | |||||
| 96 | attributes - get/set subroutine or variable attributes | ||||
| 97 | |||||
| 98 | =head1 SYNOPSIS | ||||
| 99 | |||||
| 100 | sub foo : method ; | ||||
| 101 | my ($x,@y,%z) : Bent = 1; | ||||
| 102 | my $s = sub : method { ... }; | ||||
| 103 | |||||
| 104 | use attributes (); # optional, to get subroutine declarations | ||||
| 105 | my @attrlist = attributes::get(\&foo); | ||||
| 106 | |||||
| 107 | use attributes 'get'; # import the attributes::get subroutine | ||||
| 108 | my @attrlist = get \&foo; | ||||
| 109 | |||||
| 110 | =head1 DESCRIPTION | ||||
| 111 | |||||
| 112 | Subroutine declarations and definitions may optionally have attribute lists | ||||
| 113 | associated with them. (Variable C<my> declarations also may, but see the | ||||
| 114 | warning below.) Perl handles these declarations by passing some information | ||||
| 115 | about the call site and the thing being declared along with the attribute | ||||
| 116 | list to this module. In particular, the first example above is equivalent to | ||||
| 117 | the following: | ||||
| 118 | |||||
| 119 | use attributes __PACKAGE__, \&foo, 'method'; | ||||
| 120 | |||||
| 121 | The second example in the synopsis does something equivalent to this: | ||||
| 122 | |||||
| 123 | use attributes (); | ||||
| 124 | my ($x,@y,%z); | ||||
| 125 | attributes::->import(__PACKAGE__, \$x, 'Bent'); | ||||
| 126 | attributes::->import(__PACKAGE__, \@y, 'Bent'); | ||||
| 127 | attributes::->import(__PACKAGE__, \%z, 'Bent'); | ||||
| 128 | ($x,@y,%z) = 1; | ||||
| 129 | |||||
| 130 | Yes, that's a lot of expansion. | ||||
| 131 | |||||
| 132 | B<WARNING>: attribute declarations for variables are still evolving. | ||||
| 133 | The semantics and interfaces of such declarations could change in | ||||
| 134 | future versions. They are present for purposes of experimentation | ||||
| 135 | with what the semantics ought to be. Do not rely on the current | ||||
| 136 | implementation of this feature. | ||||
| 137 | |||||
| 138 | There are only a few attributes currently handled by Perl itself (or | ||||
| 139 | directly by this module, depending on how you look at it.) However, | ||||
| 140 | package-specific attributes are allowed by an extension mechanism. | ||||
| 141 | (See L<"Package-specific Attribute Handling"> below.) | ||||
| 142 | |||||
| 143 | The setting of subroutine attributes happens at compile time. | ||||
| 144 | Variable attributes in C<our> declarations are also applied at compile time. | ||||
| 145 | However, C<my> variables get their attributes applied at run-time. | ||||
| 146 | This means that you have to I<reach> the run-time component of the C<my> | ||||
| 147 | before those attributes will get applied. For example: | ||||
| 148 | |||||
| 149 | my $x : Bent = 42 if 0; | ||||
| 150 | |||||
| 151 | will neither assign 42 to $x I<nor> will it apply the C<Bent> attribute | ||||
| 152 | to the variable. | ||||
| 153 | |||||
| 154 | An attempt to set an unrecognized attribute is a fatal error. (The | ||||
| 155 | error is trappable, but it still stops the compilation within that | ||||
| 156 | C<eval>.) Setting an attribute with a name that's all lowercase | ||||
| 157 | letters that's not a built-in attribute (such as "foo") will result in | ||||
| 158 | a warning with B<-w> or C<use warnings 'reserved'>. | ||||
| 159 | |||||
| 160 | =head2 What C<import> does | ||||
| 161 | |||||
| 162 | In the description it is mentioned that | ||||
| 163 | |||||
| 164 | sub foo : method; | ||||
| 165 | |||||
| 166 | is equivalent to | ||||
| 167 | |||||
| 168 | use attributes __PACKAGE__, \&foo, 'method'; | ||||
| 169 | |||||
| 170 | As you might know this calls the C<import> function of C<attributes> at compile | ||||
| 171 | time with these parameters: 'attributes', the caller's package name, the reference | ||||
| 172 | to the code and 'method'. | ||||
| 173 | |||||
| 174 | attributes->import( __PACKAGE__, \&foo, 'method' ); | ||||
| 175 | |||||
| 176 | So you want to know what C<import> actually does? | ||||
| 177 | |||||
| 178 | First of all C<import> gets the type of the third parameter ('CODE' in this case). | ||||
| 179 | C<attributes.pm> checks if there is a subroutine called C<< MODIFY_<reftype>_ATTRIBUTES >> | ||||
| 180 | in the caller's namespace (here: 'main'). In this case a subroutine C<MODIFY_CODE_ATTRIBUTES> is | ||||
| 181 | required. Then this method is called to check if you have used a "bad attribute". | ||||
| 182 | The subroutine call in this example would look like | ||||
| 183 | |||||
| 184 | MODIFY_CODE_ATTRIBUTES( 'main', \&foo, 'method' ); | ||||
| 185 | |||||
| 186 | C<< MODIFY_<reftype>_ATTRIBUTES >> has to return a list of all "bad attributes". | ||||
| 187 | If there are any bad attributes C<import> croaks. | ||||
| 188 | |||||
| 189 | (See L<"Package-specific Attribute Handling"> below.) | ||||
| 190 | |||||
| 191 | =head2 Built-in Attributes | ||||
| 192 | |||||
| 193 | The following are the built-in attributes for subroutines: | ||||
| 194 | |||||
| 195 | =over 4 | ||||
| 196 | |||||
| 197 | =item locked | ||||
| 198 | |||||
| 199 | B<5.005 threads only! The use of the "locked" attribute currently | ||||
| 200 | only makes sense if you are using the deprecated "Perl 5.005 threads" | ||||
| 201 | implementation of threads.> | ||||
| 202 | |||||
| 203 | Setting this attribute is only meaningful when the subroutine or | ||||
| 204 | method is to be called by multiple threads. When set on a method | ||||
| 205 | subroutine (i.e., one marked with the B<method> attribute below), | ||||
| 206 | Perl ensures that any invocation of it implicitly locks its first | ||||
| 207 | argument before execution. When set on a non-method subroutine, | ||||
| 208 | Perl ensures that a lock is taken on the subroutine itself before | ||||
| 209 | execution. The semantics of the lock are exactly those of one | ||||
| 210 | explicitly taken with the C<lock> operator immediately after the | ||||
| 211 | subroutine is entered. | ||||
| 212 | |||||
| 213 | =item method | ||||
| 214 | |||||
| 215 | Indicates that the referenced subroutine is a method. | ||||
| 216 | This has a meaning when taken together with the B<locked> attribute, | ||||
| 217 | as described there. It also means that a subroutine so marked | ||||
| 218 | will not trigger the "Ambiguous call resolved as CORE::%s" warning. | ||||
| 219 | |||||
| 220 | =item lvalue | ||||
| 221 | |||||
| 222 | Indicates that the referenced subroutine is a valid lvalue and can | ||||
| 223 | be assigned to. The subroutine must return a modifiable value such | ||||
| 224 | as a scalar variable, as described in L<perlsub>. | ||||
| 225 | |||||
| 226 | =back | ||||
| 227 | |||||
| 228 | For global variables there is C<unique> attribute: see L<perlfunc/our>. | ||||
| 229 | |||||
| 230 | =head2 Available Subroutines | ||||
| 231 | |||||
| 232 | The following subroutines are available for general use once this module | ||||
| 233 | has been loaded: | ||||
| 234 | |||||
| 235 | =over 4 | ||||
| 236 | |||||
| 237 | =item get | ||||
| 238 | |||||
| 239 | This routine expects a single parameter--a reference to a | ||||
| 240 | subroutine or variable. It returns a list of attributes, which may be | ||||
| 241 | empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>) | ||||
| 242 | to raise a fatal exception. If it can find an appropriate package name | ||||
| 243 | for a class method lookup, it will include the results from a | ||||
| 244 | C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in | ||||
| 245 | L<"Package-specific Attribute Handling"> below. | ||||
| 246 | Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned. | ||||
| 247 | |||||
| 248 | =item reftype | ||||
| 249 | |||||
| 250 | This routine expects a single parameter--a reference to a subroutine or | ||||
| 251 | variable. It returns the built-in type of the referenced variable, | ||||
| 252 | ignoring any package into which it might have been blessed. | ||||
| 253 | This can be useful for determining the I<type> value which forms part of | ||||
| 254 | the method names described in L<"Package-specific Attribute Handling"> below. | ||||
| 255 | |||||
| 256 | =back | ||||
| 257 | |||||
| 258 | Note that these routines are I<not> exported by default. | ||||
| 259 | |||||
| 260 | =head2 Package-specific Attribute Handling | ||||
| 261 | |||||
| 262 | B<WARNING>: the mechanisms described here are still experimental. Do not | ||||
| 263 | rely on the current implementation. In particular, there is no provision | ||||
| 264 | for applying package attributes to 'cloned' copies of subroutines used as | ||||
| 265 | closures. (See L<perlref/"Making References"> for information on closures.) | ||||
| 266 | Package-specific attribute handling may change incompatibly in a future | ||||
| 267 | release. | ||||
| 268 | |||||
| 269 | When an attribute list is present in a declaration, a check is made to see | ||||
| 270 | whether an attribute 'modify' handler is present in the appropriate package | ||||
| 271 | (or its @ISA inheritance tree). Similarly, when C<attributes::get> is | ||||
| 272 | called on a valid reference, a check is made for an appropriate attribute | ||||
| 273 | 'fetch' handler. See L<"EXAMPLES"> to see how the "appropriate package" | ||||
| 274 | determination works. | ||||
| 275 | |||||
| 276 | The handler names are based on the underlying type of the variable being | ||||
| 277 | declared or of the reference passed. Because these attributes are | ||||
| 278 | associated with subroutine or variable declarations, this deliberately | ||||
| 279 | ignores any possibility of being blessed into some package. Thus, a | ||||
| 280 | subroutine declaration uses "CODE" as its I<type>, and even a blessed | ||||
| 281 | hash reference uses "HASH" as its I<type>. | ||||
| 282 | |||||
| 283 | The class methods invoked for modifying and fetching are these: | ||||
| 284 | |||||
| 285 | =over 4 | ||||
| 286 | |||||
| 287 | =item FETCH_I<type>_ATTRIBUTES | ||||
| 288 | |||||
| 289 | This method is called with two arguments: the relevant package name, | ||||
| 290 | and a reference to a variable or subroutine for which package-defined | ||||
| 291 | attributes are desired. The expected return value is a list of | ||||
| 292 | associated attributes. This list may be empty. | ||||
| 293 | |||||
| 294 | =item MODIFY_I<type>_ATTRIBUTES | ||||
| 295 | |||||
| 296 | This method is called with two fixed arguments, followed by the list of | ||||
| 297 | attributes from the relevant declaration. The two fixed arguments are | ||||
| 298 | the relevant package name and a reference to the declared subroutine or | ||||
| 299 | variable. The expected return value is a list of attributes which were | ||||
| 300 | not recognized by this handler. Note that this allows for a derived class | ||||
| 301 | to delegate a call to its base class, and then only examine the attributes | ||||
| 302 | which the base class didn't already handle for it. | ||||
| 303 | |||||
| 304 | The call to this method is currently made I<during> the processing of the | ||||
| 305 | declaration. In particular, this means that a subroutine reference will | ||||
| 306 | probably be for an undefined subroutine, even if this declaration is | ||||
| 307 | actually part of the definition. | ||||
| 308 | |||||
| 309 | =back | ||||
| 310 | |||||
| 311 | Calling C<attributes::get()> from within the scope of a null package | ||||
| 312 | declaration C<package ;> for an unblessed variable reference will | ||||
| 313 | not provide any starting package name for the 'fetch' method lookup. | ||||
| 314 | Thus, this circumstance will not result in a method call for package-defined | ||||
| 315 | attributes. A named subroutine knows to which symbol table entry it belongs | ||||
| 316 | (or originally belonged), and it will use the corresponding package. | ||||
| 317 | An anonymous subroutine knows the package name into which it was compiled | ||||
| 318 | (unless it was also compiled with a null package declaration), and so it | ||||
| 319 | will use that package name. | ||||
| 320 | |||||
| 321 | =head2 Syntax of Attribute Lists | ||||
| 322 | |||||
| 323 | An attribute list is a sequence of attribute specifications, separated by | ||||
| 324 | whitespace or a colon (with optional whitespace). | ||||
| 325 | Each attribute specification is a simple | ||||
| 326 | name, optionally followed by a parenthesised parameter list. | ||||
| 327 | If such a parameter list is present, it is scanned past as for the rules | ||||
| 328 | for the C<q()> operator. (See L<perlop/"Quote and Quote-like Operators">.) | ||||
| 329 | The parameter list is passed as it was found, however, and not as per C<q()>. | ||||
| 330 | |||||
| 331 | Some examples of syntactically valid attribute lists: | ||||
| 332 | |||||
| 333 | switch(10,foo(7,3)) : expensive | ||||
| 334 | Ugly('\(") :Bad | ||||
| 335 | _5x5 | ||||
| 336 | locked method | ||||
| 337 | |||||
| 338 | Some examples of syntactically invalid attribute lists (with annotation): | ||||
| 339 | |||||
| 340 | switch(10,foo() # ()-string not balanced | ||||
| 341 | Ugly('(') # ()-string not balanced | ||||
| 342 | 5x5 # "5x5" not a valid identifier | ||||
| 343 | Y2::north # "Y2::north" not a simple identifier | ||||
| 344 | foo + bar # "+" neither a colon nor whitespace | ||||
| 345 | |||||
| 346 | =head1 EXPORTS | ||||
| 347 | |||||
| 348 | =head2 Default exports | ||||
| 349 | |||||
| 350 | None. | ||||
| 351 | |||||
| 352 | =head2 Available exports | ||||
| 353 | |||||
| 354 | The routines C<get> and C<reftype> are exportable. | ||||
| 355 | |||||
| 356 | =head2 Export tags defined | ||||
| 357 | |||||
| 358 | The C<:ALL> tag will get all of the above exports. | ||||
| 359 | |||||
| 360 | =head1 EXAMPLES | ||||
| 361 | |||||
| 362 | Here are some samples of syntactically valid declarations, with annotation | ||||
| 363 | as to how they resolve internally into C<use attributes> invocations by | ||||
| 364 | perl. These examples are primarily useful to see how the "appropriate | ||||
| 365 | package" is found for the possible method lookups for package-defined | ||||
| 366 | attributes. | ||||
| 367 | |||||
| 368 | =over 4 | ||||
| 369 | |||||
| 370 | =item 1. | ||||
| 371 | |||||
| 372 | Code: | ||||
| 373 | |||||
| 374 | package Canine; | ||||
| 375 | package Dog; | ||||
| 376 | my Canine $spot : Watchful ; | ||||
| 377 | |||||
| 378 | Effect: | ||||
| 379 | |||||
| 380 | use attributes (); | ||||
| 381 | attributes::->import(Canine => \$spot, "Watchful"); | ||||
| 382 | |||||
| 383 | =item 2. | ||||
| 384 | |||||
| 385 | Code: | ||||
| 386 | |||||
| 387 | package Felis; | ||||
| 388 | my $cat : Nervous; | ||||
| 389 | |||||
| 390 | Effect: | ||||
| 391 | |||||
| 392 | use attributes (); | ||||
| 393 | attributes::->import(Felis => \$cat, "Nervous"); | ||||
| 394 | |||||
| 395 | =item 3. | ||||
| 396 | |||||
| 397 | Code: | ||||
| 398 | |||||
| 399 | package X; | ||||
| 400 | sub foo : locked ; | ||||
| 401 | |||||
| 402 | Effect: | ||||
| 403 | |||||
| 404 | use attributes X => \&foo, "locked"; | ||||
| 405 | |||||
| 406 | =item 4. | ||||
| 407 | |||||
| 408 | Code: | ||||
| 409 | |||||
| 410 | package X; | ||||
| 411 | sub Y::x : locked { 1 } | ||||
| 412 | |||||
| 413 | Effect: | ||||
| 414 | |||||
| 415 | use attributes Y => \&Y::x, "locked"; | ||||
| 416 | |||||
| 417 | =item 5. | ||||
| 418 | |||||
| 419 | Code: | ||||
| 420 | |||||
| 421 | package X; | ||||
| 422 | sub foo { 1 } | ||||
| 423 | |||||
| 424 | package Y; | ||||
| 425 | BEGIN { *bar = \&X::foo; } | ||||
| 426 | |||||
| 427 | package Z; | ||||
| 428 | sub Y::bar : locked ; | ||||
| 429 | |||||
| 430 | Effect: | ||||
| 431 | |||||
| 432 | use attributes X => \&X::foo, "locked"; | ||||
| 433 | |||||
| 434 | =back | ||||
| 435 | |||||
| 436 | This last example is purely for purposes of completeness. You should not | ||||
| 437 | be trying to mess with the attributes of something in a package that's | ||||
| 438 | not your own. | ||||
| 439 | |||||
| 440 | =head1 MORE EXAMPLES | ||||
| 441 | |||||
| 442 | =over 4 | ||||
| 443 | |||||
| 444 | =item 1. | ||||
| 445 | |||||
| 446 | sub MODIFY_CODE_ATTRIBUTES { | ||||
| 447 | my ($class,$code,@attrs) = @_; | ||||
| 448 | |||||
| 449 | my $allowed = 'MyAttribute'; | ||||
| 450 | my @bad = grep { $_ ne $allowed } @attrs; | ||||
| 451 | |||||
| 452 | return @bad; | ||||
| 453 | } | ||||
| 454 | |||||
| 455 | sub foo : MyAttribute { | ||||
| 456 | print "foo\n"; | ||||
| 457 | } | ||||
| 458 | |||||
| 459 | This example runs. At compile time C<MODIFY_CODE_ATTRIBUTES> is called. In that | ||||
| 460 | subroutine, we check if any attribute is disallowed and we return a list of | ||||
| 461 | these "bad attributes". | ||||
| 462 | |||||
| 463 | As we return an empty list, everything is fine. | ||||
| 464 | |||||
| 465 | =item 2. | ||||
| 466 | |||||
| 467 | sub MODIFY_CODE_ATTRIBUTES { | ||||
| 468 | my ($class,$code,@attrs) = @_; | ||||
| 469 | |||||
| 470 | my $allowed = 'MyAttribute'; | ||||
| 471 | my @bad = grep{ $_ ne $allowed }@attrs; | ||||
| 472 | |||||
| 473 | return @bad; | ||||
| 474 | } | ||||
| 475 | |||||
| 476 | sub foo : MyAttribute Test { | ||||
| 477 | print "foo\n"; | ||||
| 478 | } | ||||
| 479 | |||||
| 480 | This example is aborted at compile time as we use the attribute "Test" which | ||||
| 481 | isn't allowed. C<MODIFY_CODE_ATTRIBUTES> returns a list that contains a single | ||||
| 482 | element ('Test'). | ||||
| 483 | |||||
| 484 | =back | ||||
| 485 | |||||
| 486 | =head1 SEE ALSO | ||||
| 487 | |||||
| 488 | L<perlsub/"Private Variables via my()"> and | ||||
| 489 | L<perlsub/"Subroutine Attributes"> for details on the basic declarations; | ||||
| 490 | L<attrs> for the obsolescent form of subroutine attribute specification | ||||
| 491 | which this module replaces; | ||||
| 492 | L<perlfunc/use> for details on the normal invocation mechanism. | ||||
| 493 | |||||
| 494 | =cut | ||||
| 495 | |||||
# spent 1µs within attributes::_modify_attrs which was called
# once (1µs+0s) by attributes::import at line 62 of attributes.pm | |||||
# spent 6µs within attributes::bootstrap which was called
# once (6µs+0s) by attributes::BEGIN@29 at line 29 of attributes.pm | |||||
# spent 800ns within attributes::reftype which was called
# once (800ns+0s) by attributes::import at line 38 of attributes.pm |