lib/attributes.pm

   1 package attributes;
   2
   3 $VERSION = 0.01;
   4
   5 #@EXPORT_OK = qw(get reftype);
   6 #@EXPORT = ();
   7
   8 use strict;
   9
  10 sub croak {
  11     require Carp;
  12     goto &Carp::croak;
  13 }
  14
  15 sub carp {
  16     require Carp;
  17     goto &Carp::carp;
  18 }
  19
  20 ## forward declaration(s) rather than wrapping the bootstrap call in BEGIN{}
  21 #sub reftype ($) ;
  22 #sub _fetch_attrs ($) ;
  23 #sub _guess_stash ($) ;
  24 #sub _modify_attrs ;
  25 #sub _warn_reserved () ;
  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 BEGIN { bootstrap }
  30
  31 sub import {
  32     @_ > 2 && ref $_[2] or
  33         croak 'Usage: use '.__PACKAGE__.' $home_stash, $ref, @attrlist';
  34     my (undef,$home_stash,$svref,@attrs) = @_;
  35
  36     my $svtype = uc reftype($svref);
  37     my $pkgmeth;
  38     $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES")
  39         if defined $home_stash && $home_stash ne '';
  40     my @badattrs;
  41     if ($pkgmeth) {
  42         my @pkgattrs = _modify_attrs($svref, @attrs);
  43         @badattrs = $pkgmeth->($home_stash, $svref, @attrs);
  44         if (!@badattrs && @pkgattrs) {
  45             return unless _warn_reserved;
  46             @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs;
  47             if (@pkgattrs) {
  48                 for my $attr (@pkgattrs) {
  49                     $attr =~ s/\(.+\z//s;
  50                 }
  51                 my $s = ((@pkgattrs == 1) ? '' : 's');
  52                 carp "$svtype package attribute$s " .
  53                     "may clash with future reserved word$s: " .
  54                     join(' , ' , @pkgattrs);
  55             }
  56         }
  57     }
  58     else {
  59         @badattrs = _modify_attrs($svref, @attrs);
  60     }
  61     if (@badattrs) {
  62         croak "Invalid $svtype attribute" .
  63             (( @badattrs == 1 ) ? '' : 's') .
  64             ": " .
  65             join(' , ', @badattrs);
  66     }
  67 }
  68
  69 sub get ($) {
  70     @_ == 1  && ref $_[0] or
  71         croak 'Usage: '.__PACKAGE__.'::get $ref';
  72     my $svref = shift;
  73     my $svtype = uc reftype $svref;
  74     my $stash = _guess_stash $svref;
  75     $stash = caller unless defined $stash;
  76     my $pkgmeth;
  77     $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES")
  78         if defined $stash && $stash ne '';
  79     return $pkgmeth ?
  80                 (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) :
  81                 (_fetch_attrs($svref))
  82         ;
  83 }
  84
  85 #sub export {
  86 #    require Exporter;
  87 #    goto &Exporter::import;
  88 #}
  89 #
  90 #sub require_version { goto &UNIVERSAL::VERSION }
  91
  92 1;
  93 __END__
  94 #The POD goes here
  95
  96 =head1 NAME
  97
  98 attributes - get/set subroutine or variable attributes
  99
 100 =head1 SYNOPSIS
 101
 102   sub foo : method ;
 103   my ($x,@y,%z) : Bent ;
 104   my $s = sub : method { ... };
 105
 106   use attributes ();    # optional, to get subroutine declarations
 107   my @attrlist = attributes::get(\&foo);
 108
 109 =head1 DESCRIPTION
 110
 111 Subroutine declarations and definitions may optionally have attribute lists
 112 associated with them.  (Variable C<my> declarations also may, but see the
 113 warning below.)  Perl handles these declarations by passing some information
 114 about the call site and the thing being declared along with the attribute
 115 list to this module.  In particular, first example above is equivalent to
 116 the following:
 117
 118     use attributes __PACKAGE__, \&foo, 'method';
 119
 120 The second example in the synopsis does something equivalent to this:
 121
 122     use attributes __PACKAGE__, \$x, 'Bent';
 123     use attributes __PACKAGE__, \@y, 'Bent';
 124     use attributes __PACKAGE__, \%z, 'Bent';
 125
 126 Yes, that's three invocations.
 127
 128 B<WARNING>: attribute declarations for variables are an I<experimental>
 129 feature.  The semantics of such declarations could change or be removed
 130 in future versions.  They are present for purposes of experimentation
 131 with what the semantics ought to be.  Do not rely on the current
 132 implementation of this feature.
 133
 134 There are only a few attributes currently handled by Perl itself (or
 135 directly by this module, depending on how you look at it.)  However,
 136 package-specific attributes are allowed by an extension mechanism.
 137 (See L<"Package-specific Attribute Handling"> below.)
 138
 139 The setting of attributes happens at compile time.  An attempt to set
 140 an unrecognized attribute is a fatal error.  (The error is trappable, but
 141 it still stops the compilation within that C<eval>.)  Setting an attribute
 142 with a name that's all lowercase letters that's not a built-in attribute
 143 (such as "foo")
 144 will result in a warning with B<-w> or C<use warnings 'reserved'>.
 145
 146 =head2 Built-in Attributes
 147
 148 The following are the built-in attributes for subroutines:
 149
 150 =over 4
 151
 152 =item locked
 153
 154 Setting this attribute is only meaningful when the subroutine or
 155 method is to be called by multiple threads.  When set on a method
 156 subroutine (i.e., one marked with the B<method> attribute below),
 157 Perl ensures that any invocation of it implicitly locks its first
 158 argument before execution.  When set on a non-method subroutine,
 159 Perl ensures that a lock is taken on the subroutine itself before
 160 execution.  The semantics of the lock are exactly those of one
 161 explicitly taken with the C<lock> operator immediately after the
 162 subroutine is entered.
 163
 164 =item method
 165
 166 Indicates that the referenced subroutine is a method.
 167 This has a meaning when taken together with the B<locked> attribute,
 168 as described there.  It also means that a subroutine so marked
 169 will not trigger the "Ambiguous call resolved as CORE::%s" warning.
 170
 171 =back
 172
 173 There are no built-in attributes for anything other than subroutines.
 174
 175 =head2 Available Subroutines
 176
 177 The following subroutines are available for general use once this module
 178 has been loaded:
 179
 180 =over 4
 181
 182 =item get
 183
 184 This routine expects a single parameter--a reference to a
 185 subroutine or variable.  It returns a list of attributes, which may be
 186 empty.  If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
 187 to raise a fatal exception.  If it can find an appropriate package name
 188 for a class method lookup, it will include the results from a
 189 C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
 190 L"Package-specific Attribute Handling"> below.
 191 Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
 192
 193 =item reftype
 194
 195 This routine expects a single parameter--a reference to a subroutine or
 196 variable.  It returns the built-in type of the referenced variable,
 197 ignoring any package into which it might have been blessed.
 198 This can be useful for determining the I<type> value which forms part of
 199 the method names described in L"Package-specific Attribute Handling"> below.
 200
 201 =back
 202
 203 Note that these routines are I<not> exported.  This is primarily because
 204 the C<use> mechanism which would normally import them is already in use
 205 by Perl itself to implement the C<sub : attributes> syntax.
 206
 207 =head2 Package-specific Attribute Handling
 208
 209 B<WARNING>: the mechanisms described here are still experimental.  Do not
 210 rely on the current implementation.  In particular, there is no provision
 211 for applying package attributes to 'cloned' copies of subroutines used as
 212 closures.  (See L<perlref/"Making References"> for information on closures.)
 213 Package-specific attribute handling may change incompatibly in a future
 214 release.
 215
 216 When an attribute list is present in a declaration, a check is made to see
 217 whether an attribute 'modify' handler is present in the appropriate package
 218 (or its @ISA inheritance tree).  Similarly, when C<attributes::get> is
 219 called on a valid reference, a check is made for an appropriate attribute
 220 'fetch' handler.  See L<"EXAMPLES"> to see how the "appropriate package"
 221 determination works.
 222
 223 The handler names are based on the underlying type of the variable being
 224 declared or of the reference passed.  Because these attributes are
 225 associated with subroutine or variable declarations, this deliberately
 226 ignores any possibility of being blessed into some package.  Thus, a
 227 subroutine declaration uses "CODE" as its I<type>, and even a blessed
 228 hash reference uses "HASH" as its I<type>.
 229
 230 The class methods invoked for modifying and fetching are these:
 231
 232 =over 4
 233
 234 =item FETCH_I<type>_ATTRIBUTES
 235
 236 This method receives a single argument, which is a reference to the
 237 variable or subroutine for which package-defined attributes are desired.
 238 The expected return value is a list of associated attributes.
 239 This list may be empty.
 240
 241 =item MODIFY_I<type>_ATTRIBUTES
 242
 243 This method is called with two fixed arguments, followed by the list of
 244 attributes from the relevant declaration.  The two fixed arguments are
 245 the relevant package name and a reference to the declared subroutine or
 246 variable.  The expected return value as a list of attributes which were
 247 not recognized by this handler.  Note that this allows for a derived class
 248 to delegate a call to its base class, and then only examine the attributes
 249 which the base class didn't already handle for it.
 250
 251 The call to this method is currently made I<during> the processing of the
 252 declaration.  In particular, this means that a subroutine reference will
 253 probably be for an undefined subroutine, even if this declaration is
 254 actually part of the definition.
 255
 256 =back
 257
 258 Calling C<attributes::get()> from within the scope of a null package
 259 declaration C<package ;> for an unblessed variable reference will
 260 not provide any starting package name for the 'fetch' method lookup.
 261 Thus, this circumstance will not result in a method call for package-defined
 262 attributes.  A named subroutine knows to which symbol table entry it belongs
 263 (or originally belonged), and it will use the corresponding package.
 264 An anonymous subroutine knows the package name into which it was compiled
 265 (unless it was also compiled with a null package declaration), and so it
 266 will use that package name.
 267
 268 =head2 Syntax of Attribute Lists
 269
 270 An attribute list is a sequence of attribute specifications, separated by
 271 whitespace, commas, or both.  Each attribute specification is a simple
 272 name, optionally followed by a parenthesised parameter list.
 273 If such a parameter list is present, it is scanned past as for the rules
 274 for the C<q()> operator.  (See L<perlop/"Quote and Quote-like Operators">.)
 275 The parameter list is passed as it was found, however, and not as per C<q()>.
 276
 277 Some examples of syntactically valid attribute lists:
 278
 279     switch(10,foo(7,3)) , ,  expensive
 280     Ugly('\(") , Bad
 281     _5x5
 282     locked method
 283
 284 Some examples of syntactically invalid attribute lists (with annotation):
 285
 286     switch(10,foo()             # ()-string not balanced
 287     Ugly('(')                   # ()-string not balanced
 288     5x5                         # "5x5" not a valid identifier
 289     Y2::north                   # "Y2::north" not a simple identifier
 290     foo + bar                   # "+" neither a comma nor whitespace
 291
 292 =head1 EXAMPLES
 293
 294 Here are some samples of syntactically valid declarations, with annotation
 295 as to how they resolve internally into C<use attributes> invocations by
 296 perl.  These examples are primarily useful to see how the "appropriate
 297 package" is found for the possible method lookups for package-defined
 298 attributes.
 299
 300 =over 4
 301
 302 =item 1.
 303
 304 Code:
 305
 306     package Canine;
 307     package Dog;
 308     my Canine $spot : Watchful ;
 309
 310 Effect:
 311
 312     use attributes Canine => \$spot, "Watchful";
 313
 314 =item 2.
 315
 316 Code:
 317
 318     package Felis;
 319     my $cat : Nervous;
 320
 321 Effect:
 322
 323     use attributes Felis => \$cat, "Nervous";
 324
 325 =item 3.
 326
 327 Code:
 328
 329     package X;
 330     sub foo : locked ;
 331
 332 Effect:
 333
 334     use attributes X => \&foo, "locked";
 335
 336 =item 4.
 337
 338 Code:
 339
 340     package X;
 341     sub Y::x : locked { 1 }
 342
 343 Effect:
 344
 345     use attributes Y => \&Y::x, "locked";
 346
 347 =item 5.
 348
 349 Code:
 350
 351     package X;
 352     sub foo { 1 }
 353
 354     package Y;
 355     BEGIN { *bar = \&X::foo; }
 356
 357     package Z;
 358     sub Y::bar : locked ;
 359
 360 Effect:
 361
 362     use attributes X => \&X::foo, "locked";
 363
 364 =back
 365
 366 This last example is purely for purposes of completeness.  You should not
 367 be trying to mess with the attributes of something in a package that's
 368 not your own.
 369
 370 =head1 SEE ALSO
 371
 372 L<perlsub/"Private Variables via my()"> and
 373 L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
 374 L<attrs> for the obsolescent form of subroutine attribute specification
 375 which this module replaces;
 376 L<perlfunc/use> for details on the normal invocation mechanism.
 377
 378 =cut
 379