lib/attributes.pm

   1 package attributes;
   2
   3 our $VERSION = 0.05;
   4
   5 @EXPORT_OK = qw(get reftype);
   6 @EXPORT = ();
   7 %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
   8
   9 use strict;
  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 #sub _warn_reserved () ;
  27 #
  28 # The extra trips through newATTRSUB in the interpreter wipe out any savings
  29 # from avoiding the BEGIN block.  Just do the bootstrap now.
  30 BEGIN { bootstrap attributes }
  31
  32 sub import {
  33     @_ > 2 && ref $_[2] or do {
  34         require Exporter;
  35         goto &Exporter::import;
  36     };
  37     my (undef,$home_stash,$svref,@attrs) = @_;
  38
  39     my $svtype = uc reftype($svref);
  40     my $pkgmeth;
  41     $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES")
  42         if defined $home_stash && $home_stash ne '';
  43     my @badattrs;
  44     if ($pkgmeth) {
  45         my @pkgattrs = _modify_attrs($svref, @attrs);
  46         @badattrs = $pkgmeth->($home_stash, $svref, @attrs);
  47         if (!@badattrs && @pkgattrs) {
  48             return unless _warn_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         @badattrs = _modify_attrs($svref, @attrs);
  63     }
  64     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;
  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 an I<experimental>
 133 feature.  The semantics of such declarations could change or be removed
 134 in 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
 155 an unrecognized attribute is a fatal error.  (The error is trappable, but
 156 it still stops the compilation within that C<eval>.)  Setting an attribute
 157 with a name that's all lowercase letters that's not a built-in attribute
 158 (such as "foo")
 159 will result in a warning with B<-w> or C<use warnings 'reserved'>.
 160
 161 =head2 Built-in Attributes
 162
 163 The following are the built-in attributes for subroutines:
 164
 165 =over 4
 166
 167 =item locked
 168
 169 Setting this attribute is only meaningful when the subroutine or
 170 method is to be called by multiple threads.  When set on a method
 171 subroutine (i.e., one marked with the B<method> attribute below),
 172 Perl ensures that any invocation of it implicitly locks its first
 173 argument before execution.  When set on a non-method subroutine,
 174 Perl ensures that a lock is taken on the subroutine itself before
 175 execution.  The semantics of the lock are exactly those of one
 176 explicitly taken with the C<lock> operator immediately after the
 177 subroutine is entered.
 178
 179 =item method
 180
 181 Indicates that the referenced subroutine is a method.
 182 This has a meaning when taken together with the B<locked> attribute,
 183 as described there.  It also means that a subroutine so marked
 184 will not trigger the "Ambiguous call resolved as CORE::%s" warning.
 185
 186 =item lvalue
 187
 188 Indicates that the referenced subroutine is a valid lvalue and can
 189 be assigned to. The subroutine must return a modifiable value such
 190 as a scalar variable, as described in L<perlsub>.
 191
 192 =back
 193
 194 For global variables there is C<unique> attribute: see L<perlfunc/our>.
 195
 196 =head2 Available Subroutines
 197
 198 The following subroutines are available for general use once this module
 199 has been loaded:
 200
 201 =over 4
 202
 203 =item get
 204
 205 This routine expects a single parameter--a reference to a
 206 subroutine or variable.  It returns a list of attributes, which may be
 207 empty.  If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
 208 to raise a fatal exception.  If it can find an appropriate package name
 209 for a class method lookup, it will include the results from a
 210 C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
 211 L<"Package-specific Attribute Handling"> below.
 212 Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
 213
 214 =item reftype
 215
 216 This routine expects a single parameter--a reference to a subroutine or
 217 variable.  It returns the built-in type of the referenced variable,
 218 ignoring any package into which it might have been blessed.
 219 This can be useful for determining the I<type> value which forms part of
 220 the method names described in L<"Package-specific Attribute Handling"> below.
 221
 222 =back
 223
 224 Note that these routines are I<not> exported by default.
 225
 226 =head2 Package-specific Attribute Handling
 227
 228 B<WARNING>: the mechanisms described here are still experimental.  Do not
 229 rely on the current implementation.  In particular, there is no provision
 230 for applying package attributes to 'cloned' copies of subroutines used as
 231 closures.  (See L<perlref/"Making References"> for information on closures.)
 232 Package-specific attribute handling may change incompatibly in a future
 233 release.
 234
 235 When an attribute list is present in a declaration, a check is made to see
 236 whether an attribute 'modify' handler is present in the appropriate package
 237 (or its @ISA inheritance tree).  Similarly, when C<attributes::get> is
 238 called on a valid reference, a check is made for an appropriate attribute
 239 'fetch' handler.  See L<"EXAMPLES"> to see how the "appropriate package"
 240 determination works.
 241
 242 The handler names are based on the underlying type of the variable being
 243 declared or of the reference passed.  Because these attributes are
 244 associated with subroutine or variable declarations, this deliberately
 245 ignores any possibility of being blessed into some package.  Thus, a
 246 subroutine declaration uses "CODE" as its I<type>, and even a blessed
 247 hash reference uses "HASH" as its I<type>.
 248
 249 The class methods invoked for modifying and fetching are these:
 250
 251 =over 4
 252
 253 =item FETCH_I<type>_ATTRIBUTES
 254
 255 This method receives a single argument, which is a reference to the
 256 variable or subroutine for which package-defined attributes are desired.
 257 The expected return value is a list of associated attributes.
 258 This list may be empty.
 259
 260 =item MODIFY_I<type>_ATTRIBUTES
 261
 262 This method is called with two fixed arguments, followed by the list of
 263 attributes from the relevant declaration.  The two fixed arguments are
 264 the relevant package name and a reference to the declared subroutine or
 265 variable.  The expected return value as a list of attributes which were
 266 not recognized by this handler.  Note that this allows for a derived class
 267 to delegate a call to its base class, and then only examine the attributes
 268 which the base class didn't already handle for it.
 269
 270 The call to this method is currently made I<during> the processing of the
 271 declaration.  In particular, this means that a subroutine reference will
 272 probably be for an undefined subroutine, even if this declaration is
 273 actually part of the definition.
 274
 275 =back
 276
 277 Calling C<attributes::get()> from within the scope of a null package
 278 declaration C<package ;> for an unblessed variable reference will
 279 not provide any starting package name for the 'fetch' method lookup.
 280 Thus, this circumstance will not result in a method call for package-defined
 281 attributes.  A named subroutine knows to which symbol table entry it belongs
 282 (or originally belonged), and it will use the corresponding package.
 283 An anonymous subroutine knows the package name into which it was compiled
 284 (unless it was also compiled with a null package declaration), and so it
 285 will use that package name.
 286
 287 =head2 Syntax of Attribute Lists
 288
 289 An attribute list is a sequence of attribute specifications, separated by
 290 whitespace or a colon (with optional whitespace).
 291 Each attribute specification is a simple
 292 name, optionally followed by a parenthesised parameter list.
 293 If such a parameter list is present, it is scanned past as for the rules
 294 for the C<q()> operator.  (See L<perlop/"Quote and Quote-like Operators">.)
 295 The parameter list is passed as it was found, however, and not as per C<q()>.
 296
 297 Some examples of syntactically valid attribute lists:
 298
 299     switch(10,foo(7,3))  :  expensive
 300     Ugly('\(") :Bad
 301     _5x5
 302     locked method
 303
 304 Some examples of syntactically invalid attribute lists (with annotation):
 305
 306     switch(10,foo()             # ()-string not balanced
 307     Ugly('(')                   # ()-string not balanced
 308     5x5                         # "5x5" not a valid identifier
 309     Y2::north                   # "Y2::north" not a simple identifier
 310     foo + bar                   # "+" neither a colon nor whitespace
 311
 312 =head1 EXPORTS
 313
 314 =head2 Default exports
 315
 316 None.
 317
 318 =head2 Available exports
 319
 320 The routines C<get> and C<reftype> are exportable.
 321
 322 =head2 Export tags defined
 323
 324 The C<:ALL> tag will get all of the above exports.
 325
 326 =head1 EXAMPLES
 327
 328 Here are some samples of syntactically valid declarations, with annotation
 329 as to how they resolve internally into C<use attributes> invocations by
 330 perl.  These examples are primarily useful to see how the "appropriate
 331 package" is found for the possible method lookups for package-defined
 332 attributes.
 333
 334 =over 4
 335
 336 =item 1.
 337
 338 Code:
 339
 340     package Canine;
 341     package Dog;
 342     my Canine $spot : Watchful ;
 343
 344 Effect:
 345
 346     use attributes ();
 347     attributes::->import(Canine => \$spot, "Watchful");
 348
 349 =item 2.
 350
 351 Code:
 352
 353     package Felis;
 354     my $cat : Nervous;
 355
 356 Effect:
 357
 358     use attributes ();
 359     attributes::->import(Felis => \$cat, "Nervous");
 360
 361 =item 3.
 362
 363 Code:
 364
 365     package X;
 366     sub foo : locked ;
 367
 368 Effect:
 369
 370     use attributes X => \&foo, "locked";
 371
 372 =item 4.
 373
 374 Code:
 375
 376     package X;
 377     sub Y::x : locked { 1 }
 378
 379 Effect:
 380
 381     use attributes Y => \&Y::x, "locked";
 382
 383 =item 5.
 384
 385 Code:
 386
 387     package X;
 388     sub foo { 1 }
 389
 390     package Y;
 391     BEGIN { *bar = \&X::foo; }
 392
 393     package Z;
 394     sub Y::bar : locked ;
 395
 396 Effect:
 397
 398     use attributes X => \&X::foo, "locked";
 399
 400 =back
 401
 402 This last example is purely for purposes of completeness.  You should not
 403 be trying to mess with the attributes of something in a package that's
 404 not your own.
 405
 406 =head1 SEE ALSO
 407
 408 L<perlsub/"Private Variables via my()"> and
 409 L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
 410 L<attrs> for the obsolescent form of subroutine attribute specification
 411 which this module replaces;
 412 L<perlfunc/use> for details on the normal invocation mechanism.
 413
 414 =cut
 415